home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 37 / IOPROG_37.ISO / SOFT / Multilizer.exe / disk1 / data1.cab / data1 / [Group9]VCL Source Standard / ivmldlgs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-12  |  121.9 KB  |  4,463 lines
  1. unit IvMlDlgs;
  2.  
  3. {$I IVMULTI.INC}
  4.  
  5. {$R-}
  6.  
  7. {$IFNDEF WIN32}
  8.   {$S-,W-}
  9.   {$C PRELOAD}
  10. {$ENDIF}
  11.  
  12. interface
  13.  
  14. uses
  15. {$IFDEF WIN32}
  16.   Windows,
  17. {$ELSE}
  18.   WinTypes, WinProcs,
  19. {$ENDIF}
  20.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CommDlg,
  21.   StdCtrls, ExtCtrls, Buttons, IvDictio;
  22.  
  23. type
  24. {$IFDEF WIN32}
  25.   { TIvCommonDialog }
  26.  
  27.   TIvCommonDialog = class(TComponent)
  28.   private
  29.     FCtl3D: Boolean;
  30.     FDefWndProc: Pointer;
  31.     FHelpContext: THelpContext;
  32.     FHandle: HWnd;
  33.     FObjectInstance: Pointer;
  34.     FTemplate: PChar;
  35.     FParent: TWinControl;
  36.     FPositions: TIvDialogPositions;
  37.     FDictionary: TIvDictionary;
  38.     FDictionaryName: String;
  39.     FOnClose: TNotifyEvent;
  40.     FOnShow: TNotifyEvent;
  41.  
  42.     procedure WMDestroy(var msg: TWMDestroy); message WM_DESTROY;
  43.     procedure WMInitDialog(var msg: TWMInitDialog); message WM_INITDIALOG;
  44.     procedure WMNCDestroy(var msg: TWMNCDestroy); message WM_NCDESTROY;
  45.     procedure MainWndProc(var Message: TMessage);
  46.  
  47.   protected
  48.     procedure DoClose; dynamic;
  49.     procedure DoShow; dynamic;
  50.     procedure WndProc(var msg: TMessage); virtual;
  51.     function MessageHook(var msg: TMessage): Boolean; virtual;
  52.     function TaskModalDialog(dialogFunc: Pointer; var dialogData): Bool; virtual;
  53.     function Execute: Boolean; virtual; abstract;
  54.     property Template: PChar read FTemplate write FTemplate;
  55.  
  56.     procedure SetDictionary(value: TIvDictionary);
  57.     procedure SetDictionaryName(const value: String);
  58.     procedure InitDictionary;
  59.     function GetParentWnd: HWnd;
  60.  
  61.   public
  62.     constructor Create(AOwner: TComponent); override;
  63.     destructor Destroy; override;
  64.  
  65.     procedure DefaultHandler(var msg); override;
  66.  
  67.     property Handle: HWnd read FHandle;
  68.     property Dictionary: TIvDictionary read FDictionary write SetDictionary;
  69.  
  70.   published
  71.     property Ctl3D: Boolean read FCtl3D write FCtl3D default True;
  72.     property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
  73.     property Positions: TIvDialogPositions read FPositions write FPositions default [ivdpParent, ivdpCenter];
  74.     property Parent: TWinControl read FParent write FParent;
  75.     property DictionaryName: String read FDictionaryName write SetDictionaryName;
  76.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  77.     property OnShow: TNotifyEvent read FOnShow write FOnShow;
  78.   end;
  79.  
  80.   TIvOpenDialog = class(TIvCommonDialog)
  81.   private
  82.     FHistoryList: TStrings;
  83.     FOptions: TOpenOptions;
  84.     FFilter: String;
  85.     FFilterIndex: Integer;
  86.     FCurrentFilterIndex: Integer;
  87.     FInitialDir: String;
  88.     FTitle: String;
  89.     FDefaultExt: String;
  90.     FFileName: String;
  91.     FFiles: TStrings;
  92.     FFileEditStyle: TFileEditStyle;
  93.     FOnSelectionChange: TNotifyEvent;
  94.     FOnFolderChange: TNotifyEvent;
  95.     FOnTypeChange: TNotifyEvent;
  96.  
  97.     function GetFileName: String;
  98.     function GetFilterIndex: Integer;
  99.     procedure ReadFileEditStyle(Reader: TReader);
  100.     procedure SetHistoryList(Value: TStrings);
  101.     procedure SetInitialDir(const Value: String);
  102.  
  103.   protected
  104.     procedure WndProc(var msg: TMessage); override;
  105.     procedure DefineProperties(Filer: TFiler); override;
  106.     function DoExecute(Func: Pointer): Bool;
  107.     procedure DoSelectionChange; dynamic;
  108.     procedure DoFolderChange; dynamic;
  109.     procedure DoTypeChange; dynamic;
  110. {$IFDEF IVWIDE}
  111.     function GetStaticRect: TRect; virtual;
  112. {$ENDIF}
  113.  
  114.   public
  115.     constructor Create(AOwner: TComponent); override;
  116.     destructor Destroy; override;
  117.     function Execute: Boolean; override;
  118.  
  119.     property FileEditStyle: TFileEditStyle read FFileEditStyle write FFileEditStyle;
  120.     property Files: TStrings read FFiles;
  121.     property HistoryList: TStrings read FHistoryList write SetHistoryList;
  122.  
  123.   published
  124.     property DefaultExt: String read FDefaultExt write FDefaultExt;
  125.     property FileName: String read GetFileName write FFileName;
  126.     property Filter: String read FFilter write FFilter;
  127.     property FilterIndex: Integer read GetFilterIndex write FFilterIndex default 1;
  128.     property InitialDir: String read FInitialDir write SetInitialDir;
  129.     property Options: TOpenOptions read FOptions write FOptions default [ofNoNetworkButton];
  130.     property Title: String read FTitle write FTitle;
  131.     property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
  132.     property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
  133.     property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange;
  134.   end;
  135.  
  136.   TIvSaveDialog = class(TIvOpenDialog)
  137.   public
  138.     function Execute: Boolean; override;
  139.   end;
  140.  
  141. {$IFDEF IVWIDE}
  142.   TIvOpenPictureDialog = class(TIvOpenDialog)
  143.   private
  144.     FPicture: TPicture;
  145.     FPicturePanel: TPanel;
  146.     FPictureLabel: TLabel;
  147.     FPreviewButton: TSpeedButton;
  148.     FPaintPanel: TPanel;
  149.     FPaintBox: TPaintBox;
  150.  
  151.     procedure PaintBoxPaint(Sender: TObject);
  152.     procedure PreviewClick(Sender: TObject);
  153.     procedure PreviewKeyPress(Sender: TObject; var Key: Char);
  154.  
  155.   protected
  156.     procedure DoClose; override;
  157.     procedure DoSelectionChange; override;
  158.     procedure DoShow; override;
  159.  
  160.   public
  161.     constructor Create(AOwner: TComponent); override;
  162.     destructor Destroy; override;
  163.  
  164.     function Execute: Boolean; override;
  165.   end;
  166.  
  167.   TIvSavePictureDialog = class(TIvOpenPictureDialog)
  168.     function Execute: Boolean; override;
  169.   end;
  170. {$ENDIF}
  171.  
  172.   TIvColorDialog = class(TIvCommonDialog)
  173.   private
  174.     FColor: TColor;
  175.     FOptions: TColorDialogOptions;
  176.     FCustomColors: TStrings;
  177.  
  178.     procedure SetCustomColors(Value: TStrings);
  179.  
  180.   public
  181.     constructor Create(AOwner: TComponent); override;
  182.     destructor Destroy; override;
  183.     function Execute: Boolean; override;
  184.  
  185.   published
  186.     property Color: TColor read FColor write FColor default clBlack;
  187.     property Ctl3D default False;
  188.     property CustomColors: TStrings read FCustomColors write SetCustomColors;
  189.     property Options: TColorDialogOptions read FOptions write FOptions default [];
  190.   end;
  191.  
  192.   TIvFontDialog = class(TIvCommonDialog)
  193.   private
  194.     FFont: TFont;
  195.     FDevice: TFontDialogDevice;
  196.     FOptions: TFontDialogOptions;
  197.     FOnApply: TFDApplyEvent;
  198.     FMinFontSize: Integer;
  199.     FMaxFontSize: Integer;
  200.     FFontCharsetModified: Boolean;
  201.     FFontColorModified: Boolean;
  202.  
  203.     procedure DoApply(Wnd: HWND);
  204.     procedure SetFont(Value: TFont);
  205.     procedure UpdateFromLogFont(const LogFont: TLogFont);
  206.  
  207.   protected
  208.     procedure Apply(Wnd: HWND); dynamic;
  209. {$IFDEF IVWIDE}
  210.     procedure WndProc(var msg: TMessage); override;
  211. {$ENDIF}
  212.  
  213.   public
  214.     constructor Create(AOwner: TComponent); override;
  215.     destructor Destroy; override;
  216.     function Execute: Boolean; override;
  217.  
  218.   published
  219.     property Font: TFont read FFont write SetFont;
  220.     property Device: TFontDialogDevice read FDevice write FDevice default fdScreen;
  221.     property MinFontSize: Integer read FMinFontSize write FMinFontSize;
  222.     property MaxFontSize: Integer read FMaxFontSize write FMaxFontSize;
  223.     property Options: TFontDialogOptions read FOptions write FOptions default [fdEffects];
  224.     property OnApply: TFDApplyEvent read FOnApply write FOnApply;
  225.   end;
  226.  
  227.   TIvPrinterSetupDialog = class(TIvCommonDialog)
  228.   public
  229.     function Execute: Boolean; override;
  230.   end;
  231.  
  232.   TIvPrintDialog = class(TIvCommonDialog)
  233.   private
  234.     FFromPage: Integer;
  235.     FToPage: Integer;
  236.     FCollate: Boolean;
  237.     FOptions: TPrintDialogOptions;
  238.     FPrintToFile: Boolean;
  239.     FPrintRange: TPrintRange;
  240.     FMinPage: Integer;
  241.     FMaxPage: Integer;
  242.     FCopies: Integer;
  243.  
  244.     procedure SetNumCopies(Value: Integer);
  245.  
  246.   public
  247.     function Execute: Boolean; override;
  248.  
  249.   published
  250.     property Collate: Boolean read FCollate write FCollate default False;
  251.     property Copies: Integer read FCopies write SetNumCopies default 0;
  252.     property FromPage: Integer read FFromPage write FFromPage default 0;
  253.     property MinPage: Integer read FMinPage write FMinPage default 0;
  254.     property MaxPage: Integer read FMaxPage write FMaxPage default 0;
  255.     property Options: TPrintDialogOptions read FOptions write FOptions default [];
  256.     property PrintToFile: Boolean read FPrintToFile write FPrintToFile default False;
  257.     property PrintRange: TPrintRange read FPrintRange write FPrintRange default prAllPages;
  258.     property ToPage: Integer read FToPage write FToPage default 0;
  259.   end;
  260.  
  261.   TIvFindFunc = function(var data: TFindReplace; dictionary: TIvDictionary; center: Boolean): HWnd stdcall;
  262.  
  263.   TIvFindDialog = class(TIvCommonDialog)
  264.   private
  265.     FOptions: TFindOptions;
  266.     FPosition: TPoint;
  267.     FFindReplaceFunc: TIvFindFunc;
  268.     FRedirector: TWinControl;
  269.     FOnFind: TNotifyEvent;
  270.     FOnReplace: TNotifyEvent;
  271.     FFindHandle: HWnd;
  272.     FFindReplace: TFindReplace;
  273.     FFindText: array[0..255] of Char;
  274.     FReplaceText: array[0..255] of Char;
  275.  
  276.     function GetFindText: string;
  277.     function GetLeft: Integer;
  278.     function GetPosition: TPoint;
  279.     function GetReplaceText: string;
  280.     function GetTop: Integer;
  281.     procedure SetFindText(const Value: string);
  282.     procedure SetLeft(Value: Integer);
  283.     procedure SetPosition(const Value: TPoint);
  284.     procedure SetReplaceText(const Value: string);
  285.     procedure SetTop(Value: Integer);
  286.  
  287.   protected
  288.     function MessageHook(var msg: TMessage): Boolean; override;
  289.     procedure Find; dynamic;
  290.     procedure Replace; dynamic;
  291.  
  292.   public
  293.     constructor Create(AOwner: TComponent); override;
  294.     destructor Destroy; override;
  295.     procedure CloseDialog;
  296.     function Execute: Boolean; override;
  297.     property Left: Integer read GetLeft write SetLeft;
  298.     property Position: TPoint read GetPosition write SetPosition;
  299.     property Top: Integer read GetTop write SetTop;
  300.  
  301.   published
  302.     property FindText: string read GetFindText write SetFindText;
  303.     property Options: TFindOptions read FOptions write FOptions default [frDown];
  304.     property OnFind: TNotifyEvent read FOnFind write FOnFind;
  305.   end;
  306.  
  307.   TIvReplaceDialog = class(TIvFindDialog)
  308.   public
  309.     constructor Create(AOwner: TComponent); override;
  310.  
  311.   published
  312.     property ReplaceText: string read GetReplaceText write SetReplaceText;
  313.     property OnReplace: TNotifyEvent read FOnReplace write FOnReplace;
  314.   end;
  315.  
  316. {$ELSE}
  317.   { 16 bit }
  318.  
  319.   TIvCommonDialog = class(TComponent)
  320.   private
  321.     FCtl3D: Boolean;
  322.     FHelpContext: THelpContext;
  323.     FDictionary: TIvDictionary;
  324.     FDictionaryName: String;
  325.  
  326.   protected
  327.     function Message(var msg: TMessage): Boolean; virtual;
  328.  
  329.     procedure SetDictionary(value: TIvDictionary);
  330.     procedure SetDictionaryName(const value: String);
  331.     procedure InitDictionary;
  332.  
  333.   public
  334.     constructor Create(AOwner: TComponent); override;
  335.  
  336.     property Dictionary: TIvDictionary read FDictionary write SetDictionary;
  337.  
  338.   published
  339.     property Ctl3D: Boolean read FCtl3D write FCtl3D default True;
  340.     property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
  341.     property DictionaryName: String read FDictionaryName write SetDictionaryName;
  342.   end;
  343.  
  344.   TIvOpenDialog = class;
  345.   TIvComboButton = class;
  346.  
  347.   TIvDlgControl = class(TObject)
  348.   private
  349.     FObjectInstance: Pointer;
  350.     FDefWndProc: Pointer;
  351.     FOwner: TIvComboButton;
  352.     FHandle: THandle;
  353.     FVisible: Boolean;
  354.     FReserved: Byte;
  355.  
  356.     constructor Create(Owner: TIvComboButton);
  357.     destructor Destroy; override;
  358.     procedure Init; virtual; abstract;
  359.     procedure DefaultHandler(var msg); override;
  360.     procedure SetVisible(Value: Boolean);
  361.     procedure MainWndProc(var msg: TMessage);
  362.     procedure WndProc(var msg: TMessage); virtual;
  363.     procedure WMNCDestroy(var msg: TWMNCDestroy); message WM_NCDESTROY;
  364.   end;
  365.  
  366.   TIvComboButton = class(TObject)
  367.   private
  368.     FObjectInstance: Pointer;
  369.     FDefWndProc: Pointer;
  370.     FEditWnd: HWnd;
  371.     FHandle: HWnd;
  372.     FCanvas: TCanvas;
  373.     FGlyph: TBitmap;
  374.     FDown: Boolean;
  375.     FPressed: Boolean;
  376.     FOpenDialog: TIvOpenDialog;
  377.     FDropListBox: TIvDlgControl;
  378.     FEditControl: TIvDlgControl;
  379.     FDlg: TIvDlgControl;
  380.  
  381.     constructor Create(Owner: TIvOpenDialog);
  382.     destructor Destroy; override;
  383.     procedure Closeup;
  384.     procedure DropDown;
  385.     procedure RegisterClass;
  386.     procedure Repaint;
  387.     procedure WMCommand(var msg: TWMCommand); message WM_COMMAND;
  388.     procedure WMDestroy(var msg: TWMDestroy); message WM_DESTROY;
  389.     procedure WMNCDestroy(var msg: TWMNCDestroy); message WM_NCDESTROY;
  390.     procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
  391.     procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
  392.     procedure WMLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
  393.     procedure WMMouseMove(var msg: TWMMouseMove); message WM_MOUSEMOVE;
  394.     procedure CreateWnd(Dlg: HWnd; ControlID: Word);
  395.     procedure DefaultHandler(var msg); override;
  396.     procedure WndProc(var msg: TMessage);
  397.   end;
  398.  
  399.   TIvOpenDialog = class(TIvCommonDialog)
  400.   private
  401.     FHistoryList: TStrings;
  402.     FComboBox: TIvComboButton;
  403.     FOptions: TOpenOptions;
  404.     FFilter: PString;
  405.     FFilterIndex: Integer;
  406.     FInitialDir: PString;
  407.     FTitle: PString;
  408.     FDefaultExt: TFileExt;
  409.     FFileName: TFileName;
  410.     FFiles: TStrings;
  411.     FFileEditStyle: TFileEditStyle;
  412.     FReserved: Byte;
  413.  
  414.     function GetFilter: string;
  415.     function GetInitialDir: string;
  416.     function GetFiles: TStrings;
  417.     function GetTitle: string;
  418.     procedure SetFilter(const AFilter: string);
  419.     procedure SetInitialDir(const AInitialDir: string);
  420.     procedure SetHistoryList(Value: TStrings);
  421.     procedure SetTitle(const ATitle: string);
  422.     function DoExecute(Func: Pointer): Bool;
  423.  
  424.   public
  425.     constructor Create(AOwner: TComponent); override;
  426.     destructor Destroy; override;
  427.     function Execute: Boolean; virtual;
  428.     property Files: TStrings read GetFiles;
  429.  
  430.   published
  431.     property DefaultExt: TFileExt read FDefaultExt write FDefaultExt;
  432.     property FileEditStyle: TFileEditStyle read FFileEditStyle write FFileEditStyle default fsEdit;
  433.     property FileName: TFileName read FFileName write FFileName;
  434.     property Filter: string read GetFilter write SetFilter;
  435.     property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
  436.     property InitialDir: string read GetInitialDir write SetInitialDir;
  437.     property HistoryList: TStrings read FHistoryList write SetHistoryList;
  438.     property Options: TOpenOptions read FOptions write FOptions default [];
  439.     property Title: string read GetTitle write SetTitle;
  440.   end;
  441.  
  442.   TIvSaveDialog = class(TIvOpenDialog)
  443.     function Execute: Boolean; override;
  444.   end;
  445.  
  446.   TIvColorDialog = class(TIvCommonDialog)
  447.   private
  448.     FColor: TColor;
  449.     FOptions: TColorDialogOptions;
  450.     FCustomColors: TStrings;
  451.     procedure SetCustomColors(Value: TStrings);
  452.  
  453.   public
  454.     constructor Create(AOwner: TComponent); override;
  455.     destructor Destroy; override;
  456.     function Execute: Boolean;
  457.  
  458.   published
  459.     property Color: TColor read FColor write FColor default clBlack;
  460.     property Ctl3D default False;
  461.     property CustomColors: TStrings read FCustomColors write SetCustomColors;
  462.     property Options: TColorDialogOptions read FOptions write FOptions default [];
  463.   end;
  464.  
  465.   TIvFontDialog = class(TIvCommonDialog)
  466.   private
  467.     FFont: TFont;
  468.     FDevice: TFontDialogDevice;
  469.     FOptions: TFontDialogOptions;
  470.     FOnApply: TFDApplyEvent;
  471.     FMinFontSize: Integer;
  472.     FMaxFontSize: Integer;
  473.     procedure DoApply(Wnd: HWND);
  474.     procedure SetFont(Value: TFont);
  475.     procedure UpdateFromLogFont(const LogFont: TLogFont);
  476.  
  477.   protected
  478.     procedure Apply(Wnd: HWND); dynamic;
  479.  
  480.   public
  481.     constructor Create(AOwner: TComponent); override;
  482.     destructor Destroy; override;
  483.     function Execute: Boolean;
  484.  
  485.   published
  486.     property Font: TFont read FFont write SetFont;
  487.     property Device: TFontDialogDevice read FDevice write FDevice default fdScreen;
  488.     property MinFontSize: Integer read FMinFontSize write FMinFontSize;
  489.     property MaxFontSize: Integer read FMaxFontSize write FMaxFontSize;
  490.     property Options: TFontDialogOptions read FOptions write FOptions default [fdEffects];
  491.     property OnApply: TFDApplyEvent read FOnApply write FOnApply;
  492.   end;
  493.  
  494.   TIvPrinterSetupDialog = class(TIvCommonDialog)
  495.   public
  496.     procedure Execute;
  497.   end;
  498.  
  499.   TIvPrintDialog = class(TIvPrinterSetupDialog)
  500.   private
  501.     FFromPage: Integer;
  502.     FToPage: Integer;
  503.     FCollate: Boolean;
  504.     FOptions: TPrintDialogOptions;
  505.     FPrintToFile: Boolean;
  506.     FPrintRange: TPrintRange;
  507.     FMinPage: Integer;
  508.     FMaxPage: Integer;
  509.     FCopies: Integer;
  510.  
  511.   public
  512.     function Execute: Boolean;
  513.  
  514.   published
  515.     property Collate: Boolean read FCollate write FCollate default False;
  516.     property Copies: Integer read FCopies write FCopies default 0;
  517.     property FromPage: Integer read FFromPage write FFromPage default 0;
  518.     property MinPage: Integer read FMinPage write FMinPage default 0;
  519.     property MaxPage: Integer read FMaxPage write FMaxPage default 0;
  520.     property Options: TPrintDialogOptions read FOptions write FOptions default [];
  521.     property PrintToFile: Boolean read FPrintToFile write FPrintToFile default False;
  522.     property PrintRange: TPrintRange read FPrintRange write FPrintRange default prAllPages;
  523.     property ToPage: Integer read FToPage write FToPage default 0;
  524.   end;
  525.  
  526.   TIvFindDialog = class(TIvCommonDialog)
  527.   private
  528.     FOnFind: TNotifyEvent;
  529.     FOptions: TFindOptions;
  530.     FFindText: string;
  531.     FFindReplace: TFindReplace;
  532.     FSafeHandle: HWnd;
  533.     FLeft: Integer;
  534.     FTop: Integer;
  535.  
  536.     function DoExecute(Func: Pointer): Bool;
  537.  
  538.   protected
  539.     procedure ConvertFields; virtual;
  540.     procedure ConvertFieldsForCallBack; virtual;
  541.     function GetLeft: Integer;
  542.     function GetTop: Integer;
  543.     procedure SetLeft(Value: Integer);
  544.     procedure SetTop(Value: Integer);
  545.     function GetPosition: TPoint;
  546.     procedure SetPosition(const Point: TPoint);
  547.     function Message(var msg: TMessage): Boolean; override;
  548.     procedure Find; dynamic;
  549.  
  550.   public
  551.     constructor Create(AOwner: TComponent); override;
  552.     destructor Destroy; override;
  553.     function Execute: Boolean; virtual;
  554.     procedure CloseDialog;
  555.     property Position: TPoint read GetPosition write SetPosition;
  556.     property Handle: HWnd read FSafeHandle;
  557.     property Left: Integer read GetLeft write SetLeft default -1;
  558.     property Top: Integer read GetTop write SetTop default -1;
  559.  
  560.   published
  561.     property FindText: String read FFindText write FFindText;
  562.     property Options: TFindOptions read FOptions write FOptions default [frDown];
  563.     property OnFind: TNotifyEvent read FOnFind write FOnFind;
  564.   end;
  565.  
  566.   TIvReplaceDialog = class(TIvFindDialog)
  567.   private
  568.     FOnReplace: TNotifyEvent;
  569.     FReplaceText: string;
  570.  
  571.   protected
  572.     procedure ConvertFields; override;
  573.     procedure ConvertFieldsForCallBack; override;
  574.     procedure Replace; dynamic;
  575.  
  576.   public
  577.     destructor Destroy; override;
  578.     function Execute: Boolean; override;
  579.     function Message(var msg: TMessage): Boolean; override;
  580.  
  581.   published
  582.     property ReplaceText: string read FReplaceText write FReplaceText;
  583.     property OnReplace: TNotifyEvent read FOnReplace write FOnReplace;
  584.   end;
  585. {$ENDIF}
  586.  
  587. implementation
  588.  
  589. {$IFDEF WIN32}
  590. uses
  591. {$IFDEF IVWIDE}
  592.   ExtDlgs, Dlgs,
  593. {$ENDIF}
  594.   CommCtrl, Printers,
  595.   IvDialog, IvMlCons;
  596.  
  597. {$IFDEF IVWIDE}
  598.   {$R IVMLDLGS.RES}
  599. {$ENDIF}
  600.  
  601. const
  602.   IDAPPLYBTN = $402;
  603.  
  604. var
  605.   creationControl: TIvCommonDialog = nil;
  606.   helpMsg: Cardinal;
  607.   findMsg: Cardinal;
  608.   wndProcPtrAtom: TAtom = 0;
  609.   hookCtl3D: Boolean;
  610.   commonTitle: String;
  611.   fontDialog: TIvFontDialog;
  612.  
  613. function DialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
  614. begin
  615.   Result := 0;
  616.   case Msg of
  617.     WM_INITDIALOG:
  618.       begin
  619.         if HookCtl3D then
  620.         begin
  621.           Subclass3DDlg(Wnd, CTL3D_ALL);
  622.           SetAutoSubClass(True);
  623.         end;
  624.         CreationControl.FHandle := Wnd;
  625.         CreationControl.FDefWndProc := Pointer(SetWindowLong(Wnd, GWL_WNDPROC,
  626.           Longint(CreationControl.FObjectInstance)));
  627.         CallWindowProc(CreationControl.FObjectInstance, Wnd, Msg, WParam, LParam);
  628.         CreationControl := nil;
  629.       end;
  630.     WM_DESTROY:
  631.       if HookCtl3D then
  632.         SetAutoSubClass(False);
  633.   end;
  634. end;
  635.  
  636. { TIvCommonDialog }
  637.  
  638. constructor TIvCommonDialog.Create(AOwner: TComponent);
  639. begin
  640.   inherited Create(AOwner);
  641.   FCtl3D := True;
  642.   FObjectInstance := MakeObjectInstance(MainWndProc);
  643.   FDictionary := nil;
  644.   FPositions := [ivdpParent, ivdpCenter];
  645. end;
  646.  
  647. destructor TIvCommonDialog.Destroy;
  648. begin
  649.   if FObjectInstance <> nil then
  650.     FreeObjectInstance(FObjectInstance);
  651.   inherited Destroy;
  652. end;
  653.  
  654. function TIvCommonDialog.GetParentWnd: HWnd;
  655. begin
  656.   if (ivdpParent in FPositions) and (FParent <> nil) then
  657.     Result := FParent.Handle
  658.   else if (ivdpParent in FPositions) and (Owner is TWinControl) then
  659.     Result := TWinControl(Owner).Handle
  660.   else
  661.     Result := Application.Handle;
  662. end;
  663.  
  664. procedure TIvCommonDialog.InitDictionary;
  665. begin
  666.   if FDictionaryName <> '' then
  667.     FDictionary := Dictionaries.FindDictionary(FDictionaryName);
  668.  
  669.   if (FDictionary = nil) and (Dictionaries.Count > 0) then
  670.     FDictionary := Dictionaries[0];
  671. end;
  672.  
  673. procedure TIvCommonDialog.SetDictionary(value: TIvDictionary);
  674. begin
  675.   if value <> FDictionary then
  676.   begin
  677.     FDictionary := value;
  678.     if FDictionary <> nil then
  679.       FDictionaryName := FDictionary.DictionaryName;
  680.   end;
  681. end;
  682.  
  683. procedure TIvCommonDialog.SetDictionaryName(const value: String);
  684. begin
  685.   if FDictionaryName <> value then
  686.   begin
  687.     Dictionary := Dictionaries.FindDictionary(value);
  688.     FDictionaryName := value;
  689.   end;
  690. end;
  691.  
  692. function TIvCommonDialog.MessageHook(var msg: TMessage): Boolean;
  693. begin
  694.   Result := False;
  695.   if (Msg.Msg = HelpMsg) and (FHelpContext <> 0) then
  696.   begin
  697.     Application.HelpContext(FHelpContext);
  698.     Result := True;
  699.   end;
  700. end;
  701.  
  702. procedure TIvCommonDialog.DefaultHandler(var msg);
  703. begin
  704.   if FHandle <> 0 then
  705.     with TMessage(msg) do
  706.       Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam)
  707.   else inherited DefaultHandler(msg);
  708. end;
  709.  
  710. procedure TIvCommonDialog.MainWndProc(var Message: TMessage);
  711. begin
  712.   try
  713.     WndProc(Message);
  714.   except
  715.     Application.HandleException(Self);
  716.   end;
  717. end;
  718.  
  719. procedure TIvCommonDialog.WndProc(var msg: TMessage);
  720. begin
  721.   Dispatch(msg);
  722. end;
  723.  
  724. procedure TIvCommonDialog.WMDestroy(var msg: TWMDestroy);
  725. begin
  726.   inherited;
  727.   DoClose;
  728. end;
  729.  
  730. procedure TIvCommonDialog.WMInitDialog(var msg: TWMInitDialog);
  731. begin
  732.   { Called only by non-explorer style dialogs }
  733.   DoShow;
  734.   { Prevent any further processing }
  735.   msg.Result := 0;
  736. end;
  737.  
  738. procedure TIvCommonDialog.WMNCDestroy(var msg: TWMNCDestroy);
  739. begin
  740.   inherited;
  741.   FHandle := 0;
  742. end;
  743.  
  744. function TIvCommonDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
  745. type
  746.   TDialogFunc = function(
  747.     var DialogData;
  748.     dictionary: TIvDictionary;
  749.     center: Boolean;
  750.     parent: HWnd): Bool stdcall;
  751. var
  752.   ActiveWindow: HWnd;
  753.   WindowList: Pointer;
  754. begin
  755.   ActiveWindow := GetActiveWindow;
  756.   WindowList := DisableTaskWindows(0);
  757.   try
  758.     Application.HookMainWindow(MessageHook);
  759.     try
  760.       CreationControl := Self;
  761.       Result := TDialogFunc(DialogFunc)(DialogData, FDictionary, ivdpCenter in FPositions, GetParentWnd);
  762.       // Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
  763. {$IFDEF IVWIDE}
  764.       Set8087CW(Default8087CW);
  765. {$ENDIF}
  766.     finally
  767.       Application.UnhookMainWindow(MessageHook);
  768.     end;
  769.   finally
  770.     EnableTaskWindows(WindowList);
  771.     SetActiveWindow(ActiveWindow);
  772.   end;
  773. end;
  774.  
  775. procedure TIvCommonDialog.DoClose;
  776. begin
  777.   if Assigned(FOnClose) then
  778.     FOnClose(Self);
  779. end;
  780.  
  781. procedure TIvCommonDialog.DoShow;
  782. begin
  783.   if Assigned(FOnShow) then
  784.     FOnShow(Self);
  785. end;
  786.  
  787.  
  788. { TIvOpenDialog }
  789.  
  790. function IvExplorerOpenDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  791. {$IFDEF IVBIDI}
  792.   UINT;
  793. {$ELSE}
  794.   Integer;
  795. {$ENDIF}
  796.   stdcall;
  797. begin
  798.   Result := 0;
  799.   case msg of
  800.     WM_INITDIALOG:
  801.     begin
  802.       CreationControl.FHandle := wnd;
  803.       CreationControl.FDefWndProc := Pointer(SetWindowLong(
  804.         wnd,
  805.         GWL_WNDPROC,
  806.         Longint(CreationControl.FObjectInstance)));
  807.       CallWindowProc(CreationControl.FObjectInstance, wnd, msg, wParam, lParam);
  808.       CreationControl := nil;
  809.     end;
  810.   end;
  811. end;
  812.  
  813. function IvOpenDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  814. {$IFDEF IVBIDI}
  815.   UINT;
  816. {$ELSE}
  817.   Integer;
  818. {$ENDIF}
  819.   stdcall;
  820. begin
  821.   Result := 0;
  822.   case msg of
  823.     WM_INITDIALOG:
  824.       begin
  825.         if HookCtl3D then
  826.         begin
  827.           Subclass3DDlg(Wnd, CTL3D_ALL);
  828.           SetAutoSubClass(True);
  829.         end;
  830.         CreationControl.FHandle := Wnd;
  831.         CreationControl.FDefWndProc := Pointer(SetWindowLong(
  832.           wnd,
  833.           GWL_WNDPROC,
  834.           Longint(CreationControl.FObjectInstance)));
  835.         CallWindowProc(CreationControl.FObjectInstance, wnd, msg, wParam, lParam);
  836.         CreationControl := nil;
  837.       end;
  838.  
  839.     WM_DESTROY:
  840.       if HookCtl3D then
  841.         SetAutoSubClass(False);
  842.   end;
  843. end;
  844.  
  845. function IvExplorerSaveDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  846. {$IFDEF IVBIDI}
  847.   UINT;
  848. {$ELSE}
  849.   Integer;
  850. {$ENDIF}
  851.   stdcall;
  852. begin
  853.   Result := 0;
  854.   case msg of
  855.     WM_INITDIALOG:
  856.     begin
  857.       CreationControl.FHandle := Wnd;
  858.       CreationControl.FDefWndProc := Pointer(SetWindowLong(
  859.         wnd,
  860.         GWL_WNDPROC,
  861.         Longint(CreationControl.FObjectInstance)));
  862.       CallWindowProc(CreationControl.FObjectInstance, wnd, msg, wParam, lParam);
  863.       CreationControl := nil;
  864.     end;
  865.   end;
  866. end;
  867.  
  868. function IvSaveDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  869. {$IFDEF IVBIDI}
  870.   UINT;
  871. {$ELSE}
  872.   Integer;
  873. {$ENDIF}
  874.   stdcall;
  875. begin
  876.   Result := 0;
  877.   case msg of
  878.     WM_INITDIALOG:
  879.       begin
  880.         if HookCtl3D then
  881.         begin
  882.           Subclass3DDlg(Wnd, CTL3D_ALL);
  883.           SetAutoSubClass(True);
  884.         end;
  885.         CreationControl.FHandle := Wnd;
  886.         CreationControl.FDefWndProc := Pointer(SetWindowLong(
  887.           wnd,
  888.           GWL_WNDPROC,
  889.           Longint(CreationControl.FObjectInstance)));
  890.         CallWindowProc(CreationControl.FObjectInstance, wnd, msg, wParam, lParam);
  891.         CreationControl := nil;
  892.       end;
  893.  
  894.     WM_DESTROY:
  895.       if HookCtl3D then
  896.         SetAutoSubClass(False);
  897.   end;
  898. end;
  899.  
  900. constructor TIvOpenDialog.Create(AOwner: TComponent);
  901. begin
  902.   inherited Create(AOwner);
  903.   FHistoryList := TStringList.Create;
  904.   FOptions := [ofHideReadOnly];
  905.   FFiles := TStringList.Create;
  906.   FFilterIndex := 1;
  907.   FFileEditStyle := fsEdit;
  908. end;
  909.  
  910. destructor TIvOpenDialog.Destroy;
  911. begin
  912.   FFiles.Free;
  913.   FHistoryList.Free;
  914.   inherited Destroy;
  915. end;
  916.  
  917. procedure TIvOpenDialog.WndProc(var msg: TMessage);
  918. var
  919.   index: Integer;
  920. begin
  921.   msg.Result := 0;
  922.   { If not ofOldStyleDialog then DoShow on CDN_INITDONE, not WM_INITDIALOG }
  923.   if (msg.Msg = WM_INITDIALOG) and not (ofOldStyleDialog in Options) then
  924.     Exit
  925.   else if (msg.Msg = WM_NOTIFY) then
  926.   begin
  927.     case (POFNotify(msg.LParam)^.hdr.code) of
  928.       CDN_INITDONE:
  929.         DoShow;
  930.  
  931.       CDN_SELCHANGE:
  932.         DoSelectionChange;
  933.  
  934.       CDN_FOLDERCHANGE:
  935.         DoFolderChange;
  936.  
  937.       CDN_TYPECHANGE:
  938.       begin
  939.         index := POFNotify(msg.LParam)^.lpOFN^.nFilterIndex;
  940.         if index <> FCurrentFilterIndex then
  941.         begin
  942.           FCurrentFilterIndex := index;
  943.           DoTypeChange;
  944.         end;
  945.       end;
  946.     end;
  947.   end;
  948.  
  949.   inherited WndProc(msg);
  950. end;
  951.  
  952. procedure TIvOpenDialog.DoSelectionChange;
  953. begin
  954.   if Assigned(FOnSelectionChange) then FOnSelectionChange(Self);
  955. end;
  956.  
  957. procedure TIvOpenDialog.DoFolderChange;
  958. begin
  959.   if Assigned(FOnFolderChange) then FOnFolderChange(Self);
  960. end;
  961.  
  962. procedure TIvOpenDialog.DoTypeChange;
  963. begin
  964.   if Assigned(FOnTypeChange) then FOnTypeChange(Self);
  965. end;
  966.  
  967. procedure TIvOpenDialog.ReadFileEditStyle(Reader: TReader);
  968. begin
  969.   { Ignore FileEditStyle }
  970.   Reader.ReadIdent;
  971. end;
  972.  
  973. procedure TIvOpenDialog.DefineProperties(Filer: TFiler);
  974. begin
  975.   inherited DefineProperties(Filer);
  976.   Filer.DefineProperty('FileEditStyle', ReadFileEditStyle, nil, False);
  977. end;
  978.  
  979. function TIvOpenDialog.DoExecute(Func: Pointer): Bool;
  980. const
  981.   MultiSelectBufferSize = 8192;
  982.   OpenOptions: array [TOpenOption] of Longint = (
  983.     OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
  984.     OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
  985.     OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
  986.     OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
  987.     OFN_NOTESTFILECREATE, OFN_NONETWORKBUTTON, OFN_NOLONGNAMES,
  988.     OFN_EXPLORER, OFN_NODEREFERENCELINKS
  989. {$IFDEF IVBIDI}
  990.     , OFN_ENABLEINCLUDENOTIFY, OFN_ENABLESIZING
  991. {$ENDIF}
  992.     );
  993. var
  994.   Option: TOpenOption;
  995.   OpenFilename: TOpenFilename;
  996. {$IFDEF IVWIDE}
  997.   Separator: Char;
  998. {$ENDIF}
  999.  
  1000. {$IFDEF IVWIDE}
  1001.   function AllocFilterStr(const S: string): string;
  1002.   var
  1003.     P: PChar;
  1004.   begin
  1005.     Result := '';
  1006.     if S <> '' then
  1007.     begin
  1008.       Result := S + #0;  // double null terminators
  1009.       P := AnsiStrScan(PChar(Result), '|');
  1010.       while P <> nil do
  1011.       begin
  1012.         P^ := #0;
  1013.         Inc(P);
  1014.         P := AnsiStrScan(P, '|');
  1015.       end;
  1016.     end;
  1017.   end;
  1018. {$ELSE}
  1019.   function AllocFilterStr(const S: string): PChar;
  1020.   var
  1021.     P: PChar;
  1022.   begin
  1023.     Result := nil;
  1024.     if S <> '' then
  1025.     begin
  1026.       Result := StrCopy(StrAlloc(Length(S) + 2), PChar(S));
  1027.       P := Result;
  1028.       while P^ <> #0 do
  1029.       begin
  1030.         if P^ = '|' then
  1031.           P^ := #0;
  1032.         Inc(P);
  1033.       end;
  1034.       Inc(P);
  1035.       P^ := #0;
  1036.     end;
  1037.   end;
  1038. {$ENDIF}
  1039.  
  1040.   function ExtractFileName(P: PChar; var S: string): PChar;
  1041. {$IFNDEF IVWIDE}
  1042.   var
  1043.     Separator: Char;
  1044. {$ENDIF}
  1045.   begin
  1046. {$IFDEF IVWIDE}
  1047.     Result := AnsiStrScan(P, Separator);
  1048.     if Result = nil then
  1049.     begin
  1050.       S := P;
  1051.       Result := StrEnd(P);
  1052.     end
  1053.     else
  1054.     begin
  1055.       SetString(S, P, Result - P);
  1056.       Inc(Result);
  1057.     end;
  1058. {$ELSE}
  1059.     Separator := #0;
  1060.     if (ofAllowMultiSelect in FOptions) and
  1061.       ((ofOldStyleDialog in FOptions) or not NewStyleControls) then
  1062.     begin
  1063.       Separator := ' ';
  1064.     end;
  1065.     Result := P;
  1066.     while (Result[0] <> #0) and (Result[0] <> Separator) do
  1067.       Inc(Result);
  1068.     SetString(S, P, Result - P);
  1069.     if Result[0] = Separator then
  1070.       Inc(Result);
  1071. {$ENDIF}
  1072.   end;
  1073.  
  1074.   procedure ExtractFileNames(P: PChar);
  1075.   var
  1076.     DirName, FileName: string;
  1077.   begin
  1078.     P := ExtractFileName(P, DirName);
  1079.     P := ExtractFileName(P, FileName);
  1080.     if FileName = '' then
  1081.       FFiles.Add(DirName)
  1082.     else
  1083.     begin
  1084. {$IFDEF IVWIDE}
  1085.       if AnsiLastChar(DirName)^ <> '\' then
  1086.         DirName := DirName + '\';
  1087. {$ELSE}
  1088.       if DirName[Length(DirName)] <> '\' then
  1089.         DirName := DirName + '\';
  1090. {$ENDIF}
  1091.       repeat
  1092.         if (FileName[1] <> '\') and ((Length(FileName) <= 3) or
  1093.           (FileName[2] <> ':') or (FileName[3] <> '\')) then
  1094.           FileName := DirName + FileName;
  1095.         FFiles.Add(FileName);
  1096.         P := ExtractFileName(P, FileName);
  1097.       until FileName = '';
  1098.     end;
  1099.   end;
  1100.  
  1101. var
  1102.   TempFilename, TempExt: String;
  1103. {$IFDEF IVWIDE}
  1104.   TempFilter: String;
  1105. {$ENDIF}
  1106. begin
  1107. {$IFDEF IVWIDE}
  1108.   Separator := #0;
  1109.   if (ofAllowMultiSelect in FOptions) and
  1110.     ((ofOldStyleDialog in FOptions) or not NewStyleControls) then
  1111.     Separator := ' ';
  1112. {$ENDIF}
  1113.   FFiles.Clear;
  1114.   FillChar(OpenFileName, SizeOf(OpenFileName), False);
  1115.   with OpenFilename do
  1116.   begin
  1117.     lStructSize := SizeOf(TOpenFilename);
  1118.  
  1119. {$IFDEF IVWIDE}
  1120.     hInstance := SysInit.HInstance;
  1121. {$ELSE}
  1122.     hInstance := HInstance;
  1123. {$ENDIF}
  1124.  
  1125.     hwndOwner := Application.Handle;
  1126.  
  1127. {$IFDEF IVWIDE}
  1128.     TempFilter := AllocFilterStr(FFilter);
  1129.     lpstrFilter := PChar(TempFilter);
  1130. {$ELSE}
  1131.     lpstrFilter := AllocFilterStr(FFilter);
  1132. {$ENDIF}
  1133.     nFilterIndex := FFilterIndex;
  1134.  
  1135.     if ofAllowMultiSelect in FOptions then
  1136.       nMaxFile := MultiSelectBufferSize
  1137.     else
  1138.       nMaxFile := MAX_PATH;
  1139.  
  1140.     SetLength(TempFilename, nMaxFile + 2);
  1141.     lpstrFile := PChar(TempFilename);
  1142.     FillChar(lpstrFile^, nMaxFile + 2, False);
  1143.     StrLCopy(lpstrFile, PChar(FFileName), nMaxFile);
  1144.     lpstrInitialDir := PChar(FInitialDir);
  1145.     lpstrTitle := PChar(FTitle);
  1146.     HookCtl3D := FCtl3D;
  1147.     Flags := OFN_ENABLEHOOK;
  1148.     for Option := Low(Option) to High(Option) do
  1149.     begin
  1150.       if Option in FOptions then
  1151.         Flags := Flags or Cardinal(OpenOptions[Option]);
  1152.     end;
  1153.  
  1154.     if NewStyleControls then
  1155.       Flags := Flags xor OFN_EXPLORER
  1156.     else
  1157.       Flags := Flags and not OFN_EXPLORER;
  1158.  
  1159.     TempExt := FDefaultExt;
  1160.     if (TempExt = '') and (Flags and OFN_EXPLORER = 0) then
  1161.     begin
  1162.       TempExt := ExtractFileExt(FFilename);
  1163.       Delete(TempExt, 1, 1);
  1164.     end;
  1165.  
  1166.     if TempExt <> '' then
  1167.       lpstrDefExt := PChar(TempExt);
  1168.  
  1169.     if (ofOldStyleDialog in Options) or not NewStyleControls then
  1170.     begin
  1171.       if Func = @IvGetOpenFileName then
  1172.         lpfnHook := IvOpenDialogHook
  1173.       else
  1174.         lpfnHook := IvSaveDialogHook;
  1175.     end
  1176.     else
  1177.     begin
  1178.       if Func = @IvGetOpenFileName then
  1179.         lpfnHook := IvExplorerOpenDialogHook
  1180.       else
  1181.         lpfnHook := IvExplorerSaveDialogHook;
  1182.     end;
  1183.  
  1184.     if Template <> nil then
  1185.     begin
  1186.       Flags := Flags or OFN_ENABLETEMPLATE;
  1187.       lpTemplateName := Template;
  1188.     end;
  1189.  
  1190.     commonTitle := Title;
  1191.     Result := TaskModalDialog(Func, OpenFileName);
  1192.     if Result then
  1193.     begin
  1194.       if ofAllowMultiSelect in FOptions then
  1195.       begin
  1196.         ExtractFileNames(lpstrFile);
  1197.         FFileName := FFiles[0];
  1198.       end
  1199.       else
  1200.       begin
  1201.         ExtractFileName(lpstrFile, FFileName);
  1202.         FFiles.Add(FFileName);
  1203.       end;
  1204.       if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
  1205.         Include(FOptions, ofExtensionDifferent)
  1206.       else
  1207.         Exclude(FOptions, ofExtensionDifferent);
  1208.       if (Flags and OFN_READONLY) <> 0 then
  1209.         Include(FOptions, ofReadOnly)
  1210.       else
  1211.         Exclude(FOptions, ofReadOnly);
  1212.       FFilterIndex := nFilterIndex;
  1213.     end;
  1214.   end;
  1215. end;
  1216.  
  1217. {$IFDEF IVWIDE}
  1218. function TIvOpenDialog.GetStaticRect: TRect;
  1219. begin
  1220.   if FHandle <> 0 then
  1221.   begin
  1222.     if not (ofOldStyleDialog in Options) then
  1223.     begin
  1224.       GetWindowRect(GetDlgItem(FHandle, stc32), Result);
  1225.       MapWindowPoints(0, FHandle, Result, 2);
  1226.     end
  1227.     else
  1228.       GetClientRect(FHandle, Result)
  1229.   end
  1230.   else
  1231.     Result := Rect(0,0,0,0);
  1232. end;
  1233. {$ENDIF}
  1234.  
  1235. function TIvOpenDialog.GetFileName: string;
  1236. var
  1237.   Path: array[0..MAX_PATH] of Char;
  1238. begin
  1239.   if NewStyleControls and (FHandle <> 0) then
  1240.   begin
  1241.     SendMessage(GetParent(FHandle), CDM_GETFILEPATH, SizeOf(Path), Integer(@Path));
  1242.     Result := StrPas(Path);
  1243.   end
  1244.   else Result := FFileName;
  1245. end;
  1246.  
  1247. function TIvOpenDialog.GetFilterIndex: Integer;
  1248. begin
  1249.   if FHandle <> 0 then
  1250.     Result := FCurrentFilterIndex
  1251.   else
  1252.     Result := FFilterIndex;
  1253. end;
  1254.  
  1255. procedure TIvOpenDialog.SetHistoryList(Value: TStrings);
  1256. begin
  1257.   FHistoryList.Assign(Value);
  1258. end;
  1259.  
  1260. procedure TIvOpenDialog.SetInitialDir(const Value: string);
  1261. var
  1262.   L: Integer;
  1263. begin
  1264.   L := Length(Value);
  1265. {$IFDEF IVWIDE}
  1266.   if (L > 1) and IsPathDelimiter(Value, L) and not IsDelimiter(':', Value, L - 1) then
  1267. {$ELSE}
  1268.   if (L > 1) and (Value[L] = '\') and (Value[L - 1] <> ':') then
  1269. {$ENDIF}
  1270.     Dec(L);
  1271.   FInitialDir := Copy(Value, 1, L);
  1272. end;
  1273.  
  1274. function TIvOpenDialog.Execute: Boolean;
  1275. begin
  1276.   InitDictionary;
  1277.   Result := DoExecute(@IvGetOpenFileName);
  1278. end;
  1279.  
  1280.  
  1281. { TIvSaveDialog }
  1282.  
  1283. function TIvSaveDialog.Execute: Boolean;
  1284. begin
  1285.   InitDictionary;
  1286.   Result := DoExecute(@IvGetSaveFileName);
  1287. end;
  1288.  
  1289.  
  1290. { TIvOpenPictureDialog }
  1291.  
  1292. {$IFDEF IVWIDE}
  1293. constructor TIvOpenPictureDialog.Create(AOwner: TComponent);
  1294. begin
  1295.   inherited Create(AOwner);
  1296.   Filter := GraphicFilter(TGraphic);
  1297.   FPicture := TPicture.Create;
  1298.   FPicturePanel := TPanel.Create(Self);
  1299.   with FPicturePanel do
  1300.   begin
  1301.     Name := 'PicturePanel';
  1302.     Caption := '';
  1303.     SetBounds(204, 5, 169, 200);
  1304.     BevelOuter := bvNone;
  1305.     BorderWidth := 6;
  1306.     TabOrder := 1;
  1307.     FPictureLabel := TLabel.Create(Self);
  1308.     with FPictureLabel do
  1309.     begin
  1310.       Name := 'PictureLabel';
  1311.       Caption := '';
  1312.       SetBounds(6, 6, 157, 23);
  1313.       Align := alTop;
  1314.       AutoSize := False;
  1315.       Parent := FPicturePanel;
  1316.     end;
  1317.     FPreviewButton := TSpeedButton.Create(Self);
  1318.     with FPreviewButton do
  1319.     begin
  1320.       Name := 'PreviewButton';
  1321.       SetBounds(77, 1, 23, 22);
  1322.       Enabled := False;
  1323.       Glyph.LoadFromResourceName(HInstance, 'IVPREVIEWGLYPH');
  1324.       Hint := 'Preview';
  1325.       ParentShowHint := False;
  1326.       ShowHint := True;
  1327.       OnClick := PreviewClick;
  1328.       Parent := FPicturePanel;
  1329.     end;
  1330.     FPaintPanel := TPanel.Create(Self);
  1331.     with FPaintPanel do
  1332.     begin
  1333.       Name := 'PaintPanel';
  1334.       Caption := '';
  1335.       SetBounds(6, 29, 157, 145);
  1336.       Align := alClient;
  1337.       BevelInner := bvRaised;
  1338.       BevelOuter := bvLowered;
  1339.       TabOrder := 0;
  1340.       FPaintBox := TPaintBox.Create(Self);
  1341.       Parent := FPicturePanel;
  1342.       with FPaintBox do
  1343.       begin
  1344.         Name := 'PaintBox';
  1345.         SetBounds(0, 0, 153, 141);
  1346.         Align := alClient;
  1347.         OnDblClick := PreviewClick;
  1348.         OnPaint := PaintBoxPaint;
  1349.         Parent := FPaintPanel;
  1350.       end;
  1351.     end;
  1352.   end;
  1353. end;
  1354.  
  1355. destructor TIvOpenPictureDialog.Destroy;
  1356. begin
  1357.   FPaintBox.Free;
  1358.   FPaintPanel.Free;
  1359.   FPreviewButton.Free;
  1360.   FPictureLabel.Free;
  1361.   FPicturePanel.Free;
  1362.   FPicture.Free;
  1363.   inherited Destroy;
  1364. end;
  1365.  
  1366. procedure TIvOpenPictureDialog.DoSelectionChange;
  1367. var
  1368.   FullName: string;
  1369.   ValidPicture: Boolean;
  1370.  
  1371.   function ValidFile(const FileName: String): Boolean;
  1372.   begin
  1373.     Result := GetFileAttributes(PChar(FileName)) <> $FFFFFFFF;
  1374.   end;
  1375.  
  1376. begin
  1377.   FullName := FileName;
  1378.   ValidPicture := FileExists(FullName) and ValidFile(FullName);
  1379.   if ValidPicture then
  1380.   try
  1381.     FPicture.LoadFromFile(FullName);
  1382.     FPictureLabel.Caption := Format(' (%dx%d)', [FPicture.Width, FPicture.Height]);
  1383.     FPreviewButton.Enabled := True;
  1384.   except
  1385.     ValidPicture := False;
  1386.   end;
  1387.   if not ValidPicture then
  1388.   begin
  1389.     FPictureLabel.Caption := 'Picture:';
  1390.     if FDictionary <> nil then
  1391.       FPictureLabel.Caption := FDictionary.Translate(FPictureLabel.Caption);
  1392.     FPreviewButton.Enabled := False;
  1393.     FPicture.Assign(nil);
  1394.   end;
  1395.   FPaintBox.Invalidate;
  1396.   inherited DoSelectionChange;
  1397. end;
  1398.  
  1399. procedure TIvOpenPictureDialog.DoClose;
  1400. begin
  1401.   inherited DoClose;
  1402.   { Hide any hint windows left behind }
  1403.   Application.HideHint;
  1404. end;
  1405.  
  1406. procedure TIvOpenPictureDialog.DoShow;
  1407. var
  1408.   PreviewRect, StaticRect: TRect;
  1409. begin
  1410.   { Set preview area to entire dialog }
  1411.   GetClientRect(Handle, PreviewRect);
  1412.   StaticRect := GetStaticRect;
  1413.   { Move preview area to right of static area }
  1414.   PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
  1415.   Inc(PreviewRect.Top, 4);
  1416.   FPicturePanel.BoundsRect := PreviewRect;
  1417.   FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
  1418.   FPicture.Assign(nil);
  1419.   FPicturePanel.ParentWindow := Handle;
  1420.   inherited DoShow;
  1421. end;
  1422.  
  1423. function TIvOpenPictureDialog.Execute;
  1424. begin
  1425.   InitDictionary;
  1426.   
  1427.   if NewStyleControls and not (ofOldStyleDialog in Options) then
  1428.     Template := 'IVDLGTEMPLATE'
  1429.   else
  1430.     Template := nil;
  1431.   Result := inherited Execute;
  1432. end;
  1433.  
  1434. procedure TIvOpenPictureDialog.PaintBoxPaint(Sender: TObject);
  1435. var
  1436.   DrawRect: TRect;
  1437.   SNone: string;
  1438. begin
  1439.   with TPaintBox(Sender) do
  1440.   begin
  1441.     Canvas.Brush.Color := Color;
  1442.     DrawRect := ClientRect;
  1443.     if FPicture.Width > 0 then
  1444.     begin
  1445.       with DrawRect do
  1446.         if (FPicture.Width > Right - Left) or (FPicture.Height > Bottom - Top) then
  1447.         begin
  1448.           if FPicture.Width > FPicture.Height then
  1449.             Bottom := Top + MulDiv(FPicture.Height, Right - Left, FPicture.Width)
  1450.           else
  1451.             Right := Left + MulDiv(FPicture.Width, Bottom - Top, FPicture.Height);
  1452.           Canvas.StretchDraw(DrawRect, FPicture.Graphic);
  1453.         end
  1454.         else
  1455.           with DrawRect do
  1456.             Canvas.Draw(Left + (Right - Left - FPicture.Width) div 2, Top + (Bottom - Top -
  1457.               FPicture.Height) div 2, FPicture.Graphic);
  1458.     end
  1459.     else
  1460.       with DrawRect, Canvas do
  1461.       begin
  1462.         SNone := '(None)';
  1463.         if FDictionary <> nil then
  1464.           SNone := FDictionary.Translate(SNone);
  1465.  
  1466.         TextOut(Left + (Right - Left - TextWidth(SNone)) div 2, Top + (Bottom -
  1467.           Top - TextHeight(SNone)) div 2, SNone);
  1468.       end;
  1469.   end;
  1470. end;
  1471.  
  1472. procedure TIvOpenPictureDialog.PreviewClick(Sender: TObject);
  1473. var
  1474.   PreviewForm: TForm;
  1475.   Panel: TPanel;
  1476. begin
  1477.   PreviewForm := TForm.Create(Self);
  1478.   with PreviewForm do
  1479.   try
  1480.     Name := 'PreviewForm';
  1481.     Caption := 'Preview';
  1482.     if FDictionary <> nil then
  1483.       Caption := FDictionary.Translate(Caption);
  1484.     BorderStyle := bsSizeToolWin;
  1485.     KeyPreview := True;
  1486.     Position := poScreenCenter;
  1487.     OnKeyPress := PreviewKeyPress;
  1488.     Panel := TPanel.Create(PreviewForm);
  1489.     with Panel do
  1490.     begin
  1491.       Name := 'Panel';
  1492.       Caption := '';
  1493.       Align := alClient;
  1494.       BevelOuter := bvNone;
  1495.       BorderStyle := bsSingle;
  1496.       BorderWidth := 5;
  1497.       Color := clWindow;
  1498.       Parent := PreviewForm;
  1499.       with TImage.Create(PreviewForm) do
  1500.       begin
  1501.         Name := 'Image';
  1502.         Caption := '';
  1503.         Align := alClient;
  1504.         Stretch := True;
  1505.         Picture.Assign(FPicture);
  1506.         Parent := Panel;
  1507.       end;
  1508.     end;
  1509.     if FPicture.Width > 0 then
  1510.     begin
  1511.       ClientWidth := FPicture.Width + (ClientWidth - Panel.ClientWidth)+ 10;
  1512.       ClientHeight := FPicture.Height + (ClientHeight - Panel.ClientHeight) + 10;
  1513.     end;
  1514.     ShowModal;
  1515.   finally
  1516.     Free;
  1517.   end;
  1518. end;
  1519.  
  1520. procedure TIvOpenPictureDialog.PreviewKeyPress(Sender: TObject; var Key: Char);
  1521. begin
  1522.   if Key = #27 then
  1523.     TForm(Sender).Close;
  1524. end;
  1525.  
  1526.  
  1527. { TIvSavePictureDialog }
  1528.  
  1529. function TIvSavePictureDialog.Execute: Boolean;
  1530. begin
  1531.   InitDictionary;
  1532.  
  1533.   if NewStyleControls and not (ofOldStyleDialog in Options) then
  1534.     Template := 'IVDLGTEMPLATE'
  1535.   else
  1536.     Template := nil;
  1537.   Result := DoExecute(@IvGetSaveFileName);
  1538. end;
  1539. {$ENDIF}
  1540.  
  1541.  
  1542. { TIvColorDialog }
  1543.  
  1544. function IvColorDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  1545. {$IFDEF IVBIDI}
  1546.   UINT;
  1547. {$ELSE}
  1548.   Integer;
  1549. {$ENDIF}
  1550.   stdcall;
  1551. begin
  1552.   Result := 0;
  1553.   case Msg of
  1554.     WM_INITDIALOG:
  1555.       begin
  1556.         if HookCtl3D then
  1557.         begin
  1558.           Subclass3DDlg(Wnd, CTL3D_ALL);
  1559.           SetAutoSubClass(True);
  1560.         end;
  1561.         CreationControl.FHandle := Wnd;
  1562.         CreationControl.FDefWndProc := Pointer(SetWindowLong(Wnd, GWL_WNDPROC,
  1563.           Longint(CreationControl.FObjectInstance)));
  1564.         CallWindowProc(CreationControl.FObjectInstance, Wnd, Msg, WParam, LParam);
  1565.         CreationControl := nil;
  1566.       end;
  1567.  
  1568.     WM_DESTROY:
  1569.       if HookCtl3D then
  1570.         SetAutoSubClass(False);
  1571.   end;
  1572. end;
  1573.  
  1574. constructor TIvColorDialog.Create(AOwner: TComponent);
  1575. begin
  1576.   inherited Create(AOwner);
  1577.   FCustomColors := TStringList.Create;
  1578. end;
  1579.  
  1580. destructor TIvColorDialog.Destroy;
  1581. begin
  1582.   FCustomColors.Free;
  1583.   inherited Destroy;
  1584. end;
  1585.  
  1586. function TIvColorDialog.Execute: Boolean;
  1587. const
  1588.   DialogOptions: array[TColorDialogOption] of LongInt = (
  1589.     CC_FULLOPEN, CC_PREVENTFULLOPEN, CC_SHOWHELP, CC_SOLIDCOLOR,
  1590.     CC_ANYCOLOR);
  1591. var
  1592.   ChooseColorRec: TChooseColor;
  1593.   Option: TColorDialogOption;
  1594.   CustomColorsArray: TCustomColors;
  1595.   ColorPrefix, ColorTags: string;
  1596.  
  1597.   procedure GetCustomColorsArray;
  1598.   var
  1599.     I: Integer;
  1600.   begin
  1601.     for I := 0 to MaxCustomColors - 1 do
  1602.       FCustomColors.Values[ColorPrefix + ColorTags[I + 1]] :=
  1603.         Format('%.6x', [CustomColorsArray[I]]);
  1604.   end;
  1605.  
  1606.   procedure SetCustomColorsArray;
  1607.   var
  1608.     Value: string;
  1609.     I: Integer;
  1610.   begin
  1611.     for I := 0 to MaxCustomColors - 1 do
  1612.     begin
  1613.       Value := FCustomColors.Values[ColorPrefix + ColorTags[I + 1]];
  1614.       if Value <> '' then
  1615.         CustomColorsArray[I] := StrToInt('$' + Value) else
  1616.         CustomColorsArray[I] := -1;
  1617.     end;
  1618.   end;
  1619.  
  1620. begin
  1621.   InitDictionary;
  1622.  
  1623.   ColorPrefix := 'Color';
  1624.   ColorTags := 'ABCDEFGHIJKLMNOP';
  1625.   with ChooseColorRec do
  1626.   begin
  1627.     SetCustomColorsArray;
  1628.     lStructSize := SizeOf(ChooseColorRec);
  1629.  
  1630. {$IFDEF IVWIDE}
  1631.     hInstance := SysInit.HInstance;
  1632. {$ELSE}
  1633.     hInstance := HInstance;
  1634. {$ENDIF}
  1635.  
  1636.     hwndOwner := Application.Handle;
  1637.  
  1638.     rgbResult := ColorToRGB(FColor);
  1639.     lpCustColors := Pointer(@CustomColorsArray);
  1640.     Flags := CC_RGBINIT or CC_ENABLEHOOK;
  1641.     for Option := Low(Option) to High(Option) do
  1642.       if Option in FOptions then
  1643.         Flags := Flags or Cardinal(DialogOptions[Option]);
  1644.  
  1645.     if Template <> nil then
  1646.     begin
  1647.       Flags := Flags or CC_ENABLETEMPLATE;
  1648.       lpTemplateName := Template;
  1649.     end;
  1650.  
  1651.     HookCtl3D := FCtl3D;
  1652.     lpfnHook := IvColorDialogHook;
  1653.     lCustData := Longint(FDictionary);
  1654.     Result := TaskModalDialog(@IvChooseColor, ChooseColorRec);
  1655.     if Result then
  1656.     begin
  1657.       FColor := rgbResult;
  1658.       GetCustomColorsArray;
  1659.     end;
  1660.   end;
  1661. end;
  1662.  
  1663. procedure TIvColorDialog.SetCustomColors(Value: TStrings);
  1664. begin
  1665.   FCustomColors.Assign(Value);
  1666. end;
  1667.  
  1668.  
  1669. { TIvFontDialog }
  1670.  
  1671. function IvFontDialogHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  1672. {$IFDEF IVBIDI}
  1673.   UINT;
  1674. {$ELSE}
  1675.   Integer;
  1676. {$ENDIF}
  1677.   stdcall;
  1678. begin
  1679.   if (Msg = WM_COMMAND) and
  1680.     (LongRec(WParam).Lo = IDAPPLYBTN) and
  1681.     (LongRec(WParam).Hi = BN_CLICKED) then
  1682.   begin
  1683.     FontDialog.DoApply(Wnd);
  1684.     Result := 1;
  1685.   end else
  1686.     Result := DialogHook(Wnd, Msg, wParam, lParam);
  1687. end;
  1688.  
  1689. constructor TIvFontDialog.Create(AOwner: TComponent);
  1690. begin
  1691.   inherited Create(AOwner);
  1692.   FFont := TFont.Create;
  1693.   FOptions := [fdEffects];
  1694. end;
  1695.  
  1696. destructor TIvFontDialog.Destroy;
  1697. begin
  1698.   FFont.Free;
  1699.   inherited Destroy;
  1700. end;
  1701.  
  1702. {$IFDEF IVWIDE}
  1703. procedure TIvFontDialog.WndProc(var msg: TMessage);
  1704. begin
  1705.   { Make sure we only take values from the color combobox and script combobox
  1706.     if they have been changed. }
  1707.   if (msg.Msg = WM_COMMAND) and (msg.WParamHi = CBN_SELENDOK) then
  1708.   begin
  1709.     if (msg.WParamLo = cmb4) then
  1710.       FFontColorModified := True
  1711.     else if (msg.WParamLo = cmb5) then
  1712.       FFontCharsetModified := True;
  1713.   end;
  1714.  
  1715.   inherited WndProc(msg);
  1716. end;
  1717. {$ENDIF}
  1718.  
  1719. procedure TIvFontDialog.Apply(Wnd: HWND);
  1720. begin
  1721.   if Assigned(FOnApply) then
  1722.     FOnApply(Self, Wnd);
  1723. end;
  1724.  
  1725. procedure TIvFontDialog.DoApply(Wnd: HWND);
  1726. const
  1727.   IDCOLORCMB = $473;
  1728. var
  1729.   I: Integer;
  1730.   LogFont: TLogFont;
  1731. begin
  1732.   SendMessage(Wnd, WM_CHOOSEFONT_GETLOGFONT, 0, LongInt(@LogFont));
  1733.   UpdateFromLogFont(LogFont);
  1734.   I := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETCURSEL, 0, 0);
  1735.   if I <> CB_ERR then
  1736.     Font.Color := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETITEMDATA, I, 0);
  1737.   try
  1738.     Apply(Wnd);
  1739.   except
  1740.     Application.HandleException(Self);
  1741.   end;
  1742. end;
  1743.  
  1744. function TIvFontDialog.Execute: Boolean;
  1745. const
  1746.   FontOptions: array[TFontDialogOption] of Longint = (
  1747.     CF_ANSIONLY, CF_TTONLY, CF_EFFECTS, CF_FIXEDPITCHONLY, CF_FORCEFONTEXIST,
  1748.     CF_NOFACESEL, CF_NOOEMFONTS, CF_NOSIMULATIONS, CF_NOSIZESEL,
  1749.     CF_NOSTYLESEL, CF_NOVECTORFONTS, CF_SHOWHELP, CF_WYSIWYG, CF_LIMITSIZE,
  1750.     CF_SCALABLEONLY, CF_APPLY);
  1751.   Devices: array[TFontDialogDevice] of Longint = (
  1752.     CF_SCREENFONTS, CF_PRINTERFONTS, CF_BOTH);
  1753. var
  1754.   ChooseFontRec: TChooseFont;
  1755.   LogFont: TLogFont;
  1756.   Option: TFontDialogOption;
  1757.   SaveFontDialog: TIvFontDialog;
  1758.   OriginalFaceName: String;
  1759. begin
  1760.   InitDictionary;
  1761.  
  1762.   with ChooseFontRec do
  1763.   begin
  1764.     lStructSize := SizeOf(ChooseFontRec);
  1765.  
  1766. {$IFDEF IVWIDE}
  1767.     hInstance := SysInit.HInstance;
  1768. {$ELSE}
  1769.     hInstance := HInstance;
  1770. {$ENDIF}
  1771.  
  1772.     hwndOwner := Application.Handle;
  1773.  
  1774.     hDC := 0;
  1775.     if FDevice <> fdScreen then
  1776.       hDC := Printer.Handle;
  1777.     lpLogFont := @LogFont;
  1778.     GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
  1779.     OriginalFaceName := LogFont.lfFaceName;
  1780.     Flags := Devices[FDevice] or (CF_INITTOLOGFONTSTRUCT or CF_ENABLEHOOK);
  1781.     for Option := Low(Option) to High(Option) do
  1782.       if Option in FOptions then
  1783.         Flags := Flags or Cardinal(FontOptions[Option]);
  1784.     if Assigned(FOnApply) then
  1785.       Flags := Flags or CF_APPLY;
  1786.     if Template <> nil then
  1787.     begin
  1788.       Flags := Flags or CF_ENABLETEMPLATE;
  1789.       lpTemplateName := Template;
  1790.     end;
  1791.     rgbColors := Font.Color;
  1792.     lCustData := 0;
  1793.     HookCtl3D := Ctl3D;
  1794.     lpfnHook := IvFontDialogHook;
  1795.     nSizeMin := FMinFontSize;
  1796.     nSizeMax := FMaxFontSize;
  1797.     if nSizeMin > nSizeMax then
  1798.       Flags := Flags and (not CF_LIMITSIZE);
  1799.     SaveFontDialog := FontDialog;
  1800.     FontDialog := Self;
  1801.     FFontColorModified := False;
  1802.     FFontCharsetModified := False;
  1803.     Result := TaskModalDialog(@IvChooseFont, ChooseFontRec);
  1804.     FontDialog := SaveFontDialog;
  1805.     if Result then
  1806.     begin
  1807. {$IFDEF IVWIDE}
  1808.       if AnsiCompareText(OriginalFaceName, LogFont.lfFaceName) <> 0 then
  1809.         FFontCharsetModified := True;
  1810. {$ENDIF}
  1811.       UpdateFromLogFont(LogFont);
  1812. {$IFDEF IVWIDE}
  1813.       if FFontColorModified then
  1814. {$ENDIF}
  1815.         Font.Color := rgbColors;
  1816.     end;
  1817.   end;
  1818. end;
  1819.  
  1820. procedure TIvFontDialog.SetFont(Value: TFont);
  1821. begin
  1822.   FFont.Assign(Value);
  1823. end;
  1824.  
  1825. procedure TIvFontDialog.UpdateFromLogFont(const LogFont: TLogFont);
  1826. var
  1827.   Style: TFontStyles;
  1828. begin
  1829.   with LogFont do
  1830.   begin
  1831.     Font.Name := LogFont.lfFaceName;
  1832.     Font.Height := LogFont.lfHeight;
  1833. {$IFDEF IVWIDE}
  1834.     if FFontCharsetModified then
  1835.       Font.Charset := TFontCharset(LogFont.lfCharSet);
  1836. {$ENDIF}
  1837.     Style := [];
  1838.     with LogFont do
  1839.     begin
  1840.       if lfWeight > FW_REGULAR then
  1841.         Include(Style, fsBold);
  1842.  
  1843.       if lfItalic <> 0 then
  1844.         Include(Style, fsItalic);
  1845.  
  1846.       if lfUnderline <> 0 then
  1847.         Include(Style, fsUnderline);
  1848.  
  1849.       if lfStrikeOut <> 0 then
  1850.         Include(Style, fsStrikeOut);
  1851.     end;
  1852.     Font.Style := Style;
  1853.   end;
  1854. end;
  1855.  
  1856.  
  1857. { Printer dialog routines }
  1858.  
  1859. procedure GetPrinter(var deviceMode, deviceNames: THandle);
  1860. var
  1861.   Device, Driver, Port: array[0..79] of Char;
  1862.   DevNames: PDevNames;
  1863.   Offset: PChar;
  1864. begin
  1865.   Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  1866.   if DeviceMode <> 0 then
  1867.   begin
  1868.     DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) +
  1869.      StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3);
  1870.     DevNames := PDevNames(GlobalLock(DeviceNames));
  1871.     try
  1872.       Offset := PChar(DevNames) + SizeOf(TDevnames);
  1873.       with DevNames^ do
  1874.       begin
  1875.         wDriverOffset := Longint(Offset) - Longint(DevNames);
  1876.         Offset := StrECopy(Offset, Driver) + 1;
  1877.         wDeviceOffset := Longint(Offset) - Longint(DevNames);
  1878.         Offset := StrECopy(Offset, Device) + 1;
  1879.         wOutputOffset := Longint(Offset) - Longint(DevNames);;
  1880.         StrCopy(Offset, Port);
  1881.       end;
  1882.     finally
  1883.       GlobalUnlock(DeviceNames);
  1884.     end;
  1885.   end;
  1886. end;
  1887.  
  1888. procedure SetPrinter(DeviceMode, DeviceNames: THandle);
  1889. var
  1890.   DevNames: PDevNames;
  1891. begin
  1892.   DevNames := PDevNames(GlobalLock(DeviceNames));
  1893.   try
  1894.     with DevNames^ do
  1895.       Printer.SetPrinter(PChar(DevNames) + wDeviceOffset,
  1896.         PChar(DevNames) + wDriverOffset,
  1897.         PChar(DevNames) + wOutputOffset, DeviceMode);
  1898.   finally
  1899.     GlobalUnlock(DeviceNames);
  1900.     GlobalFree(DeviceNames);
  1901.   end;
  1902. end;
  1903.  
  1904. function CopyData(Handle: THandle): THandle;
  1905. var
  1906.   Src, Dest: PChar;
  1907.   Size: Integer;
  1908. begin
  1909.   if Handle <> 0 then
  1910.   begin
  1911.     Size := GlobalSize(Handle);
  1912.     Result := GlobalAlloc(GHND, Size);
  1913.     if Result <> 0 then
  1914.       try
  1915.         Src := GlobalLock(Handle);
  1916.         Dest := GlobalLock(Result);
  1917.         if (Src <> nil) and (Dest <> nil) then
  1918.           Move(Src^, Dest^, Size);
  1919.       finally
  1920.         GlobalUnlock(Handle);
  1921.         GlobalUnlock(Result);
  1922.       end
  1923.   end
  1924.   else
  1925.     Result := 0;
  1926. end;
  1927.  
  1928.  
  1929. { TIvPrinterSetupDialog }
  1930.  
  1931. function IvPrintHook(wnd: HWnd; msg: UINT; wParam: WPARAM; lParam: LPARAM):
  1932. {$IFDEF IVBIDI}
  1933.   UINT;
  1934. {$ELSE}
  1935.   Integer;
  1936. {$ENDIF}
  1937.   stdcall;
  1938. begin
  1939.   Result := 0;
  1940.   case Msg of
  1941.     WM_INITDIALOG:
  1942.       begin
  1943.         if HookCtl3D then
  1944.         begin
  1945.           Subclass3DDlg(Wnd, CTL3D_ALL);
  1946.           SetAutoSubClass(True);
  1947.         end;
  1948.         CreationControl.FHandle := Wnd;
  1949.         CreationControl.FDefWndProc := Pointer(SetWindowLong(
  1950.             Wnd,
  1951.             GWL_WNDPROC,
  1952.             Longint(CreationControl.FObjectInstance)));
  1953.         CallWindowProc(CreationControl.FObjectInstance, Wnd, Msg, WParam, LParam);
  1954.         CreationControl := nil;
  1955.       end;
  1956.  
  1957.     WM_DESTROY:
  1958.       if HookCtl3D then
  1959.         SetAutoSubClass(False);
  1960.   end;
  1961. end;
  1962.  
  1963. function TIvPrinterSetupDialog.Execute: Boolean;
  1964. var
  1965.   PrintDlgRec: TPrintDlg;
  1966.   DevHandle: THandle;
  1967. begin
  1968.   InitDictionary;
  1969.   
  1970.   FillChar(PrintDlgRec, SizeOf(PrintDlgRec), False);
  1971.   with PrintDlgRec do
  1972.   begin
  1973.     lStructSize := SizeOf(PrintDlgRec);
  1974.  
  1975. {$IFDEF IVWIDE}
  1976.     hInstance := SysInit.HInstance;
  1977. {$ELSE}
  1978.     hInstance := HInstance;
  1979. {$ENDIF}
  1980.  
  1981.     hwndOwner := Application.Handle;
  1982.  
  1983.     GetPrinter(DevHandle, hDevNames);
  1984.     hDevMode := CopyData(DevHandle);
  1985.     Flags := PD_ENABLESETUPHOOK or PD_PRINTSETUP;
  1986.     HookCtl3D := Ctl3D;
  1987.     lpfnSetupHook := IvPrintHook;
  1988.  
  1989.     Result := TaskModalDialog(@IvPrintDlg, PrintDlgRec);
  1990.     if Result then
  1991.       SetPrinter(hDevMode, hDevNames)
  1992.     else
  1993.     begin
  1994.       if hDevMode <> 0 then
  1995.         GlobalFree(hDevMode);
  1996.       if hDevNames <> 0 then
  1997.         GlobalFree(hDevNames);
  1998.     end;
  1999.   end;
  2000. end;
  2001.  
  2002.  
  2003. { TIvPrintDialog }
  2004.  
  2005. procedure TIvPrintDialog.SetNumCopies(Value: Integer);
  2006. begin
  2007.   FCopies := Value;
  2008.   Printer.Copies := Value;
  2009. end;
  2010.  
  2011. function TIvPrintDialog.Execute: Boolean;
  2012. const
  2013.   PrintRanges: array[TPrintRange] of Integer =
  2014.     (PD_ALLPAGES, PD_SELECTION, PD_PAGENUMS);
  2015. var
  2016.   PrintDlgRec: TPrintDlg;
  2017.   DevHandle: THandle;
  2018. begin
  2019.   InitDictionary;
  2020.   
  2021.   FillChar(PrintDlgRec, SizeOf(PrintDlgRec), False);
  2022.   with PrintDlgRec do
  2023.   begin
  2024.     lStructSize := SizeOf(PrintDlgRec);
  2025.  
  2026. {$IFDEF IVWIDE}
  2027.     hInstance := SysInit.HInstance;
  2028. {$ELSE}
  2029.     hInstance := HInstance;
  2030. {$ENDIF}
  2031.  
  2032.     hwndOwner := Application.Handle;
  2033.  
  2034.     GetPrinter(DevHandle, hDevNames);
  2035.     hDevMode := CopyData(DevHandle);
  2036.     Flags := PrintRanges[FPrintRange] or (PD_ENABLEPRINTHOOK or PD_ENABLESETUPHOOK);
  2037.  
  2038.     if FCollate then
  2039.       Inc(Flags, PD_COLLATE);
  2040.  
  2041.     if not (poPrintToFile in FOptions) then
  2042.       Inc(Flags, PD_HIDEPRINTTOFILE);
  2043.  
  2044.     if not (poPageNums in FOptions) then
  2045.       Inc(Flags, PD_NOPAGENUMS);
  2046.  
  2047.     if not (poSelection in FOptions) then
  2048.       Inc(Flags, PD_NOSELECTION);
  2049.  
  2050.     if poDisablePrintToFile in FOptions then
  2051.       Inc(Flags, PD_DISABLEPRINTTOFILE);
  2052.  
  2053.     if FPrintToFile then
  2054.       Inc(Flags, PD_PRINTTOFILE);
  2055.  
  2056.     if poHelp in FOptions then
  2057.       Inc(Flags, PD_SHOWHELP);
  2058.  
  2059.     if not (poWarning in FOptions) then
  2060.       Inc(Flags, PD_NOWARNING);
  2061.  
  2062.     nFromPage := FFromPage;
  2063.     nToPage := FToPage;
  2064.     nMinPage := FMinPage;
  2065.     nMaxPage := FMaxPage;
  2066.     HookCtl3D := Ctl3D;
  2067.     lpfnPrintHook := IvPrintHook;
  2068.     lpfnSetupHook := IvPrintHook;
  2069.  
  2070.     Result := TaskModalDialog(@IvPrintDlg, PrintDlgRec);
  2071.     if Result then
  2072.     begin
  2073.       SetPrinter(hDevMode, hDevNames);
  2074.       FCollate := Flags and PD_COLLATE <> 0;
  2075.       FPrintToFile := Flags and PD_PRINTTOFILE <> 0;
  2076.       if Flags and PD_SELECTION <> 0 then
  2077.         FPrintRange := prSelection
  2078.       else if Flags and PD_PAGENUMS <> 0 then
  2079.         FPrintRange := prPageNums
  2080.       else
  2081.         FPrintRange := prAllPages;
  2082.       FFromPage := nFromPage;
  2083.       FToPage := nToPage;
  2084.       if nCopies = 1 then
  2085.         Copies := Printer.Copies
  2086.       else
  2087.         Copies := nCopies;
  2088.     end
  2089.     else
  2090.     begin
  2091.       if hDevMode <> 0 then
  2092.         GlobalFree(hDevMode);
  2093.       if hDevNames <> 0 then
  2094.         GlobalFree(hDevNames);
  2095.     end;
  2096.   end;
  2097. end;
  2098.  
  2099. { TRedirectorWindow }
  2100. { A redirector window is used to put the find/replace dialog into the
  2101.   ownership chain of a form, but intercept messages that CommDlg.dll sends
  2102.   exclusively to the find/replace dialog's owner.  TRedirectorWindow
  2103.   creates its hidden window handle as owned by the target form, and the
  2104.   find/replace dialog handle is created as owned by the redirector.  The
  2105.   redirector wndproc forwards all messages to the find/replace component.
  2106. }
  2107.  
  2108. type
  2109.   TRedirectorWindow = class(TWinControl)
  2110.   private
  2111.     FFindReplaceDialog: TIvFindDialog;
  2112.     FFormHandle: THandle;
  2113.     procedure CMRelease(var Message); message CM_Release;
  2114.   protected
  2115.     procedure CreateParams(var Params: TCreateParams); override;
  2116.     procedure WndProc(var Message: TMessage); override;
  2117.   end;
  2118.  
  2119. procedure TRedirectorWindow.CreateParams(var Params: TCreateParams);
  2120. begin
  2121.   inherited CreateParams(Params);
  2122.   with Params do
  2123.   begin
  2124.     Style := WS_VISIBLE or WS_POPUP;
  2125.     WndParent := FFormHandle;
  2126.   end;
  2127. end;
  2128.  
  2129. procedure TRedirectorWindow.WndProc(var Message: TMessage);
  2130. begin
  2131.   inherited WndProc(Message);
  2132.   if (Message.Result = 0) and Assigned(FFindReplaceDialog) then
  2133.     Message.Result := Integer(FFindReplaceDialog.MessageHook(Message));
  2134. end;
  2135.  
  2136. procedure TRedirectorWindow.CMRelease(var Message);
  2137. begin
  2138.   Free;
  2139. end;
  2140.  
  2141.  
  2142. { Find and Replace dialog routines }
  2143.  
  2144. function IvFindReplaceWndProc(Wnd: HWND; Msg, WParam, LParam: Longint): Longint; stdcall;
  2145.  
  2146.   function CallDefWndProc: Longint;
  2147.   begin
  2148.     Result := CallWindowProc(Pointer(GetProp(Wnd,
  2149.       MakeIntAtom(WndProcPtrAtom))), Wnd, Msg, WParam, LParam);
  2150.   end;
  2151.  
  2152. begin
  2153.   case Msg of
  2154.     WM_DESTROY:
  2155.       if Application.DialogHandle = Wnd then
  2156.         Application.DialogHandle := 0;
  2157.  
  2158.     WM_NCACTIVATE:
  2159.       if WParam <> 0 then
  2160.       begin
  2161.         if Application.DialogHandle = 0 then
  2162.           Application.DialogHandle := Wnd;
  2163.       end
  2164.       else
  2165.       begin
  2166.         if Application.DialogHandle = Wnd then
  2167.           Application.DialogHandle := 0;
  2168.       end;
  2169.  
  2170.     WM_NCDESTROY:
  2171.       begin
  2172.         Result := CallDefWndProc;
  2173.         RemoveProp(Wnd, MakeIntAtom(WndProcPtrAtom));
  2174.         Exit;
  2175.       end;
  2176.    end;
  2177.    Result := CallDefWndProc;
  2178. end;
  2179.  
  2180. function IvFindDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
  2181. begin
  2182.   Result := DialogHook(Wnd, Msg, wParam, lParam);
  2183.   case Msg of
  2184.     WM_DESTROY:
  2185.       if HookCtl3D then
  2186.         SetAutoSubClass(False);
  2187.   end;
  2188.  
  2189.   if Msg = WM_INITDIALOG then
  2190.   begin
  2191.     with TIvFindDialog(PFindReplace(LParam)^.lCustData) do
  2192.       if (Left <> -1) or (Top <> -1) then
  2193.         SetWindowPos(Wnd, 0, Left, Top, 0, 0, SWP_NOACTIVATE or
  2194.           SWP_NOSIZE or SWP_NOZORDER);
  2195.     SetProp(Wnd, MakeIntAtom(WndProcPtrAtom), GetWindowLong(Wnd, GWL_WNDPROC));
  2196.     SetWindowLong(Wnd, GWL_WNDPROC, Longint(@IvFindReplaceWndProc));
  2197.     Result := 1;
  2198.   end;
  2199. end;
  2200.  
  2201. function IvReplaceDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
  2202. begin
  2203.   Result := DialogHook(Wnd, Msg, wParam, lParam);
  2204.   case Msg of
  2205.     WM_DESTROY:
  2206.       if HookCtl3D then
  2207.         SetAutoSubClass(False);
  2208.   end;
  2209.  
  2210.   if Msg = WM_INITDIALOG then
  2211.   begin
  2212.     with TIvFindDialog(PFindReplace(LParam)^.lCustData) do
  2213.       if (Left <> -1) or (Top <> -1) then
  2214.         SetWindowPos(Wnd, 0, Left, Top, 0, 0, SWP_NOACTIVATE or
  2215.           SWP_NOSIZE or SWP_NOZORDER);
  2216.     SetProp(Wnd, MakeIntAtom(WndProcPtrAtom), GetWindowLong(Wnd, GWL_WNDPROC));
  2217.     SetWindowLong(Wnd, GWL_WNDPROC, Longint(@IvFindReplaceWndProc));
  2218.     Result := 1;
  2219.   end;
  2220. end;
  2221.  
  2222. const
  2223.   FindOptions: array[TFindOption] of Longint = (
  2224.     FR_DOWN, FR_FINDNEXT, FR_HIDEMATCHCASE, FR_HIDEWHOLEWORD,
  2225.     FR_HIDEUPDOWN, FR_MATCHCASE, FR_NOMATCHCASE, FR_NOUPDOWN, FR_NOWHOLEWORD,
  2226.     FR_REPLACE, FR_REPLACEALL, FR_WHOLEWORD, FR_SHOWHELP);
  2227.  
  2228. { TIvFindDialog }
  2229.  
  2230. constructor TIvFindDialog.Create(AOwner: TComponent);
  2231. begin
  2232.   inherited Create(AOwner);
  2233.   FOptions := [frDown];
  2234.   FPosition.X := -1;
  2235.   FPosition.Y := -1;
  2236.   with FFindReplace do
  2237.   begin
  2238.     lStructSize := SizeOf(TFindReplace);
  2239. {$IFDEF IVWIDE}
  2240.     hInstance := SysInit.HInstance;
  2241. {$ELSE}
  2242.     hInstance := HInstance;
  2243. {$ENDIF}
  2244.     hWndOwner := Application.Handle;
  2245.     lpstrFindWhat := FFindText;
  2246.     wFindWhatLen := SizeOf(FFindText);
  2247.     lpstrReplaceWith := FReplaceText;
  2248.     wReplaceWithLen := SizeOf(FReplaceText);
  2249.     lCustData := Longint(Self);
  2250.     lpfnHook := IvFindDialogHook;
  2251.   end;
  2252.   FFindReplaceFunc := TIvFindFunc(@IvFindText);
  2253. end;
  2254.  
  2255. destructor TIvFindDialog.Destroy;
  2256. begin
  2257.   if FHandle <> 0 then
  2258.     SendMessage(FHandle, WM_CLOSE, 0, 0);
  2259.   FRedirector.Free;
  2260.   inherited Destroy;
  2261. end;
  2262.  
  2263. procedure TIvFindDialog.CloseDialog;
  2264. begin
  2265.   if FHandle <> 0 then
  2266.     PostMessage(FHandle, WM_CLOSE, 0, 0);
  2267. end;
  2268.  
  2269. function GetTopWindow(Wnd: THandle; var ReturnVar: THandle):Bool; stdcall;
  2270. var
  2271.   Test: TWinControl;
  2272. begin
  2273.   Test := FindControl(Wnd);
  2274.   Result := True;
  2275.   if Assigned(Test) and (Test is TForm) then
  2276.   begin
  2277.     ReturnVar := Wnd;
  2278.     Result := False;
  2279.    end;
  2280. end;
  2281.  
  2282. function TIvFindDialog.Execute: Boolean;
  2283. var
  2284.   Option: TFindOption;
  2285. begin
  2286.   InitDictionary;
  2287.   
  2288.   if FHandle <> 0 then
  2289.   begin
  2290.     BringWindowToTop(FHandle);
  2291.     Result := True;
  2292.   end
  2293.   else
  2294.   begin
  2295.     HookCtl3D := Ctl3D;
  2296.     FFindReplace.Flags := FR_ENABLEHOOK;
  2297.     if Self is TIvReplaceDialog then
  2298.       FFindReplace.lpfnHook := IvReplaceDialogHook
  2299.     else
  2300.       FFindReplace.lpfnHook := IvFindDialogHook;
  2301.     FRedirector := TRedirectorWindow.Create(nil);
  2302.     with TRedirectorWindow(FRedirector) do
  2303.     begin
  2304.       FFindReplaceDialog := Self;
  2305.       EnumThreadWindows(GetCurrentThreadID, @GetTopWindow, LPARAM(@FFormHandle));
  2306.     end;
  2307.  
  2308.     FFindReplace.hwndOwner := FRedirector.Handle;
  2309.  
  2310.     for Option := Low(Option) to High(Option) do
  2311.       if Option in FOptions then
  2312.         FFindReplace.Flags := FFindReplace.Flags or Cardinal(FindOptions[Option]);
  2313.     if Template <> nil then
  2314.     begin
  2315.       FFindReplace.Flags := FFindReplace.Flags or FR_ENABLETEMPLATE;
  2316.       FFindReplace.lpTemplateName := Template;
  2317.     end;
  2318.     CreationControl := Self;
  2319.     FFindHandle := FFindReplaceFunc(FFindReplace, FDictionary, ivdpCenter in FPositions);
  2320.     Result := FHandle <> 0;
  2321.   end;
  2322. end;
  2323.  
  2324. procedure TIvFindDialog.Find;
  2325. begin
  2326.   if Assigned(FOnFind) then
  2327.     FOnFind(Self);
  2328. end;
  2329.  
  2330. function TIvFindDialog.GetFindText: string;
  2331. begin
  2332.   Result := FFindText;
  2333. end;
  2334.  
  2335. function TIvFindDialog.GetLeft: Integer;
  2336. begin
  2337.   Result := Position.X;
  2338. end;
  2339.  
  2340. function TIvFindDialog.GetPosition: TPoint;
  2341. var
  2342.   Rect: TRect;
  2343. begin
  2344.   Result := FPosition;
  2345.   if FHandle <> 0 then
  2346.   begin
  2347.     GetWindowRect(FHandle, Rect);
  2348.     Result := Rect.TopLeft;
  2349.   end;
  2350. end;
  2351.  
  2352. function TIvFindDialog.GetReplaceText: string;
  2353. begin
  2354.   Result := FReplaceText;
  2355. end;
  2356.  
  2357. function TIvFindDialog.GetTop: Integer;
  2358. begin
  2359.   Result := Position.Y;
  2360. end;
  2361.  
  2362. function TIvFindDialog.MessageHook(var Msg: TMessage): Boolean;
  2363. var
  2364.   Option: TFindOption;
  2365.   Rect: TRect;
  2366. begin
  2367.   Result := inherited MessageHook(Msg);
  2368.   if not Result then
  2369.     if (Msg.Msg = FindMsg) and (Pointer(Msg.LParam) = @FFindReplace) then
  2370.     begin
  2371.       FOptions := [];
  2372.       for Option := Low(Option) to High(Option) do
  2373.         if (FFindReplace.Flags and FindOptions[Option]) <> 0 then
  2374.           Include(FOptions, Option);
  2375.       if (FFindReplace.Flags and FR_FINDNEXT) <> 0 then
  2376.         Find
  2377.       else if (FFindReplace.Flags and (FR_REPLACE or FR_REPLACEALL)) <> 0 then
  2378.         Replace
  2379.       else if (FFindReplace.Flags and FR_DIALOGTERM) <> 0 then
  2380.       begin
  2381.         GetWindowRect(FHandle, Rect);
  2382.         FPosition := Rect.TopLeft;
  2383.         FHandle := 0;
  2384.         PostMessage(FRedirector.Handle,CM_RELEASE,0,0); // free redirector later
  2385.         FRedirector := nil;
  2386.       end;
  2387.       Result := True;
  2388.     end;
  2389. end;
  2390.  
  2391. procedure TIvFindDialog.Replace;
  2392. begin
  2393.   if Assigned(FOnReplace) then
  2394.     FOnReplace(Self);
  2395. end;
  2396.  
  2397. procedure TIvFindDialog.SetFindText(const Value: string);
  2398. begin
  2399.   StrLCopy(FFindText, PChar(Value), SizeOf(FFindText) - 1);
  2400. end;
  2401.  
  2402. procedure TIvFindDialog.SetLeft(Value: Integer);
  2403. begin
  2404.   SetPosition(Point(Value, Top));
  2405. end;
  2406.  
  2407. procedure TIvFindDialog.SetPosition(const Value: TPoint);
  2408. begin
  2409.   if (FPosition.X <> Value.X) or (FPosition.Y <> Value.Y) then
  2410.   begin
  2411.     FPosition := Value;
  2412.     if FHandle <> 0 then
  2413.       SetWindowPos(
  2414.         FHandle,
  2415.         0,
  2416.         Value.X,
  2417.         Value.Y,
  2418.         0,
  2419.         0,
  2420.         SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  2421.   end;
  2422. end;
  2423.  
  2424. procedure TIvFindDialog.SetReplaceText(const Value: string);
  2425. begin
  2426.   StrLCopy(FReplaceText, PChar(Value), SizeOf(FReplaceText) - 1);
  2427. end;
  2428.  
  2429. procedure TIvFindDialog.SetTop(Value: Integer);
  2430. begin
  2431.   SetPosition(Point(Left, Value));
  2432. end;
  2433.  
  2434. { TIvReplaceDialog }
  2435.  
  2436. constructor TIvReplaceDialog.Create(AOwner: TComponent);
  2437. begin
  2438.   inherited Create(AOwner);
  2439.   FFindReplaceFunc := TIvFindFunc(@IvReplaceText);
  2440.   with FFindReplace do
  2441.     lpfnHook := IvReplaceDialogHook;
  2442. end;
  2443.  
  2444. { Initialization and cleanup }
  2445.  
  2446. procedure InitGlobals;
  2447. var
  2448.   AtomText: array[0..31] of Char;
  2449. begin
  2450.   HelpMsg := RegisterWindowMessage(HelpMsgString);
  2451.   FindMsg := RegisterWindowMessage(FindMsgString);
  2452.   WndProcPtrAtom := GlobalAddAtom(StrFmt(
  2453.     AtomText,
  2454.     'IvWndProcPtr%.8X%.8X',
  2455.     [HInstance, GetCurrentThreadID]));
  2456. end;
  2457.  
  2458. initialization
  2459.   InitGlobals;
  2460. finalization
  2461.   if WndProcPtrAtom <> 0 then
  2462.     GlobalDeleteAtom(WndProcPtrAtom);
  2463. {$ELSE}
  2464.  
  2465. { 16 bit }
  2466.  
  2467. uses
  2468.   Printers, Consts, Dlgs,
  2469.   IvDialog;
  2470.  
  2471. type
  2472.   TTranslateFunction = function(wnd: HWnd; reserved: Longint): Bool;
  2473.  
  2474.   TIvDropListBox = class(TIvDlgControl)
  2475.   private
  2476.     procedure Init; override;
  2477.     procedure WMLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
  2478.   end;
  2479.  
  2480.   TIvDlgEditControl = class(TIvDlgControl)
  2481.   private
  2482.     procedure Init; override;
  2483.     procedure DefaultHandler(var msg); override;
  2484.     procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS;
  2485.   end;
  2486.  
  2487.   TIvCommonDlg = class(TIvDlgControl)
  2488.   private
  2489.     procedure Init; override;
  2490.     procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
  2491.     procedure WMNCLButtonDown(var msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  2492.   end;
  2493.  
  2494. const
  2495.   WndProcSegAtom: TAtom = 0;
  2496.   WndProcOfsAtom: TAtom = 0;
  2497.   EditControlId = 1152;
  2498.   HookCtl3D: Boolean = False;
  2499.   HookColorDlg: Boolean = False;
  2500.   ComboBox: TIvComboButton = nil;
  2501.   DialogTitle: PChar = nil;
  2502.  
  2503. var
  2504.   HelpMsg: Word;
  2505.   FindMsg: Word;
  2506.   counter: Integer;
  2507.   translateFunction: TTranslateFunction;
  2508.   translateDictionary: TIvDictionary;
  2509.  
  2510. procedure TranslateWindow(wnd: HWnd; const str: String; resize: Boolean);
  2511. var
  2512.   dc: HDC;
  2513.   width, style: Integer;
  2514.   rect, calcRect: TRect;
  2515.   buffer: array[0..255] of Char;
  2516. begin
  2517.   { Changes the text of the window. If resizing was allowed resized the window. }
  2518.  
  2519.   SetWindowText(wnd, StrPCopy(buffer, str));
  2520.   if resize then
  2521.   begin
  2522.     { Calculates the width of the text. If the current width of the windows is
  2523.       less then resizez the window. }
  2524.  
  2525.     dc := GetWindowDC(wnd);
  2526.     SelectObject(dc, GetStockObject(SYSTEM_FONT));
  2527.     width := DrawText(dc, StrPCopy(buffer, str), -1, calcRect, DT_LEFT or DT_CALCRECT or DT_SINGLELINE);
  2528.     ReleaseDC(wnd, dc);
  2529.     if width <= 0 then
  2530.       Exit;
  2531.  
  2532.     width := calcRect.right - calcRect.left;
  2533.     GetClassName(wnd, buffer, SizeOf(buffer));
  2534.     StrLower(buffer);
  2535.     if StrComp(buffer, 'button') = 0 then
  2536.     begin
  2537.       { Check box and radion buttons need some space for the input area. }
  2538.  
  2539.       style := GetWindowLong(wnd, GWL_STYLE);
  2540.       if ((style and BS_CHECKBOX) <> 0) or ((style and BS_RADIOBUTTON) <> 0) then
  2541.         width := width + 20
  2542.       else
  2543.         Exit;
  2544.     end;
  2545.  
  2546.     { If the current width is less the the needed width resizes the windows }
  2547.  
  2548.     GetWindowRect(wnd, rect);
  2549.     if (rect.right - rect.left) < width then
  2550.       SetWindowPos(wnd, 0, 0, 0, width, rect.bottom - rect.top, SWP_NOMOVE or SWP_NOZORDER);
  2551.   end;
  2552. end;
  2553.  
  2554. function IvTranslateOpenDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2555. begin
  2556.   Result := True;
  2557.   if (wnd = 0) or (translateDictionary = nil) then
  2558.     Exit;
  2559.  
  2560.   { Translates the window text }
  2561.  
  2562.   case GetWindowWord(wnd, GWW_ID) of
  2563.     0: TranslateWindow(wnd, translateDictionary.Translate('Open'), False);
  2564.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2565.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2566.     1037: TranslateWindow(wnd, translateDictionary.Translate('Net&work...'), True);
  2567.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2568.     1040: TranslateWindow(wnd, translateDictionary.Translate('&Read only'), True);
  2569.     1089: TranslateWindow(wnd, translateDictionary.Translate('List files of &type:'), True);
  2570.     1090: TranslateWindow(wnd, translateDictionary.Translate('File &name:'), True);
  2571.     1091: TranslateWindow(wnd, translateDictionary.Translate('Dri&ves:'), True);
  2572.     65535: TranslateWindow(wnd, translateDictionary.Translate('&Folders:'), True);
  2573.   end;
  2574.  
  2575.   { Translates the child controls }
  2576.  
  2577.   EnumChildWindows(wnd, @IvTranslateOpenDialog, 0);
  2578. end;
  2579.  
  2580. function IvTranslateSaveDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2581. begin
  2582.   Result := True;
  2583.   if translateDictionary = nil then
  2584.     Exit;
  2585.  
  2586.   { Translates the window text }
  2587.  
  2588.   case GetWindowWord(wnd, GWW_ID) of
  2589.     0: TranslateWindow(wnd, translateDictionary.Translate('Save As'), False);
  2590.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2591.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2592.     1037: TranslateWindow(wnd, translateDictionary.Translate('Net&work...'), True);
  2593.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2594.     1040: TranslateWindow(wnd, translateDictionary.Translate('&Read only'), True);
  2595.     1089: TranslateWindow(wnd, translateDictionary.Translate('Save file as &type:'), True);
  2596.     1090: TranslateWindow(wnd, translateDictionary.Translate('File &name:'), True);
  2597.     1091: TranslateWindow(wnd, translateDictionary.Translate('Dri&ves:'), True);
  2598.     65535: TranslateWindow(wnd, translateDictionary.Translate('&Folders:'), True);
  2599.   end;
  2600.  
  2601.   { Translates the child controls }
  2602.  
  2603.   EnumChildWindows(wnd, @IvTranslateSaveDialog, 0);
  2604. end;
  2605.  
  2606. function IvTranslateColorDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2607. begin
  2608.   Result := True;
  2609.   if translateDictionary = nil then
  2610.     Exit;
  2611.  
  2612.   { Translates the window text }
  2613.  
  2614.   case GetWindowWord(wnd, GWW_ID) of
  2615.     0: TranslateWindow(wnd, translateDictionary.Translate('Color'), False);
  2616.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2617.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2618.     712: TranslateWindow(wnd, translateDictionary.Translate('&Add to Custom Colors'), True);
  2619.     719: TranslateWindow(wnd, translateDictionary.Translate('&Define Custom Colors >>'), True);
  2620.     723: TranslateWindow(wnd, translateDictionary.Translate('Hu&e:'), True);
  2621.     724: TranslateWindow(wnd, translateDictionary.Translate('&Sat:'), True);
  2622.     725: TranslateWindow(wnd, translateDictionary.Translate('&Lum:'), True);
  2623.     726: TranslateWindow(wnd, translateDictionary.Translate('&Red:'), True);
  2624.     727: TranslateWindow(wnd, translateDictionary.Translate('&Green:'), True);
  2625.     728: TranslateWindow(wnd, translateDictionary.Translate('Bl&ue:'), True);
  2626.     730: TranslateWindow(wnd, translateDictionary.Translate('Color'), True);
  2627.     731: TranslateWindow(wnd, translateDictionary.Translate('|S&olid'), True);
  2628.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2629.     65535:
  2630.       begin
  2631.         case counter of
  2632.           0: TranslateWindow(wnd, translateDictionary.Translate('&Basic colors:'), True);
  2633.           1: TranslateWindow(wnd, translateDictionary.Translate('&Custom colors:'), True);
  2634.         end;
  2635.         Inc(counter);
  2636.       end;
  2637.   end;
  2638.  
  2639.   { Translates the child controls }
  2640.  
  2641.   EnumChildWindows(wnd, @IvTranslateColorDialog, 0);
  2642. end;
  2643.  
  2644. function IvTranslateFontDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2645. begin
  2646.   Result := True;
  2647.   if translateDictionary = nil then
  2648.     Exit;
  2649.  
  2650.   { Translates the window text }
  2651.  
  2652.   case GetWindowWord(wnd, GWW_ID) of
  2653.     0: TranslateWindow(wnd, translateDictionary.Translate('Font'), False);
  2654.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2655.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2656.     1026: TranslateWindow(wnd, translateDictionary.Translate('&Apply'), True);
  2657.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2658.     1040: TranslateWindow(wnd, translateDictionary.Translate('Stri&keout'), True);
  2659.     1041: TranslateWindow(wnd, translateDictionary.Translate('&Underline'), True);
  2660.     1072: TranslateWindow(wnd, translateDictionary.Translate('Effects'), True);
  2661.     1073: TranslateWindow(wnd, translateDictionary.Translate('Sample'), True);
  2662.     1088: TranslateWindow(wnd, translateDictionary.Translate('&Font:'), True);
  2663.     1089: TranslateWindow(wnd, translateDictionary.Translate('Font st&yle:'), True);
  2664.     1090: TranslateWindow(wnd, translateDictionary.Translate('&Size:'), True);
  2665.     1091: TranslateWindow(wnd, translateDictionary.Translate('&Color:'), True);
  2666.     1094: TranslateWindow(wnd, translateDictionary.Translate('Sc&ript:'), True);
  2667.   end;
  2668.  
  2669.   { Translates the child controls }
  2670.  
  2671.   EnumChildWindows(wnd, @IvTranslateFontDialog, 0);
  2672. end;
  2673.  
  2674. function IvTranslatePrintDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2675. begin
  2676.   Result := True;
  2677.   if translateDictionary = nil then
  2678.     Exit;
  2679.  
  2680.   { Translates the window text }
  2681.  
  2682.   case GetWindowWord(wnd, GWW_ID) of
  2683.     0: TranslateWindow(wnd, translateDictionary.Translate('Print'), False);
  2684.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2685.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2686.     1024: TranslateWindow(wnd, translateDictionary.Translate('&Setup...'), True);
  2687.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2688.     1040: TranslateWindow(wnd, translateDictionary.Translate('Print to fi&le'), True);
  2689.     1041: TranslateWindow(wnd, translateDictionary.Translate('Collate cop&ies'), True);
  2690.     1056: TranslateWindow(wnd, translateDictionary.Translate('&All'), True);
  2691.     1057: TranslateWindow(wnd, translateDictionary.Translate('S&election'), True);
  2692.     1058: TranslateWindow(wnd, translateDictionary.Translate('&Pages'), True);
  2693.     1072: TranslateWindow(wnd, translateDictionary.Translate('Print range'), True);
  2694.     1089: TranslateWindow(wnd, translateDictionary.Translate('&From:'), True);
  2695.     1090: TranslateWindow(wnd, translateDictionary.Translate('&To:'), True);
  2696.     1091: TranslateWindow(wnd, translateDictionary.Translate('Print &quality:'), True);
  2697.     1092: TranslateWindow(wnd, translateDictionary.Translate('&Copies:'), True);
  2698.     1093: TranslateWindow(wnd, translateDictionary.Translate('Printer:'), True);
  2699.   end;
  2700.  
  2701.   { Translates the child controls }
  2702.  
  2703.   EnumChildWindows(wnd, @IvTranslatePrintDialog, 0);
  2704. end;
  2705.  
  2706. function IvTranslatePrinterSetupDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2707. begin
  2708.   Result := True;
  2709.   if translateDictionary = nil then
  2710.     Exit;
  2711.  
  2712.   { Translates the window text }
  2713.  
  2714.   case GetWindowWord(wnd, GWW_ID) of
  2715.     0: TranslateWindow(wnd, translateDictionary.Translate('Print Setup'), False);
  2716.     1: TranslateWindow(wnd, translateDictionary.Translate('OK'), True);
  2717.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2718.     1024: TranslateWindow(wnd, translateDictionary.Translate('&Options...'), True);
  2719.     1037: TranslateWindow(wnd, translateDictionary.Translate('Net&work...'), True);
  2720.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2721.     1056: TranslateWindow(wnd, translateDictionary.Translate('Po&rtrait'), True);
  2722.     1057: TranslateWindow(wnd, translateDictionary.Translate('&Landscape'), True);
  2723.     1058: TranslateWindow(wnd, translateDictionary.Translate('&Default printer'), True);
  2724.     1059: TranslateWindow(wnd, translateDictionary.Translate('Specific &printer:'), True);
  2725.     1072: TranslateWindow(wnd, translateDictionary.Translate('Orientation'), True);
  2726.     1073: TranslateWindow(wnd, translateDictionary.Translate('Paper'), True);
  2727.     1074: TranslateWindow(wnd, translateDictionary.Translate('Printer'), True);
  2728.     1089: TranslateWindow(wnd, translateDictionary.Translate('Si&ze:'), True);
  2729.     1090: TranslateWindow(wnd, translateDictionary.Translate('&Source:'), True);
  2730.   end;
  2731.  
  2732.   { Translates the child controls }
  2733.  
  2734.   EnumChildWindows(wnd, @IvTranslatePrinterSetupDialog, 0);
  2735. end;
  2736.  
  2737. function IvTranslateFindDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2738. begin
  2739.   Result := True;
  2740.   if translateDictionary = nil then
  2741.     Exit;
  2742.  
  2743.   { Translates the window text }
  2744.  
  2745.   case GetWindowWord(wnd, GWW_ID) of
  2746.     0: TranslateWindow(wnd, translateDictionary.Translate('Find'), False);
  2747.     1: TranslateWindow(wnd, translateDictionary.Translate('&Find Next'), True);
  2748.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2749.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2750.     1040: TranslateWindow(wnd, translateDictionary.Translate('Match &whole word only'), True);
  2751.     1041: TranslateWindow(wnd, translateDictionary.Translate('Match &case'), True);
  2752.     1056: TranslateWindow(wnd, translateDictionary.Translate('&Up'), True);
  2753.     1057: TranslateWindow(wnd, translateDictionary.Translate('&Down'), True);
  2754.     1072: TranslateWindow(wnd, translateDictionary.Translate('Direction'), True);
  2755.     65535: TranslateWindow(wnd, translateDictionary.Translate('Fi&nd what:'), True);
  2756.   end;
  2757.  
  2758.   { Translates the child controls }
  2759.  
  2760.   EnumChildWindows(wnd, @IvTranslateFindDialog, 0);
  2761. end;
  2762.  
  2763. function IvTranslateReplaceDialog(wnd: HWnd; reserved: Longint): Bool; export;
  2764. begin
  2765.   Result := True;
  2766.   if translateDictionary = nil then
  2767.     Exit;
  2768.  
  2769.   { Translates the window text }
  2770.  
  2771.   case GetWindowWord(wnd, GWW_ID) of
  2772.     0: TranslateWindow(wnd, translateDictionary.Translate('Replace'), False);
  2773.     1: TranslateWindow(wnd, translateDictionary.Translate('&Find Next'), True);
  2774.     2: TranslateWindow(wnd, translateDictionary.Translate('Cancel'), True);
  2775.     1038: TranslateWindow(wnd, translateDictionary.Translate('&Help'), True);
  2776.     1024: TranslateWindow(wnd, translateDictionary.Translate('&Replace'), True);
  2777.     1025: TranslateWindow(wnd, translateDictionary.Translate('Replace &All'), True);
  2778.     1040: TranslateWindow(wnd, translateDictionary.Translate('Match &whole word only'), True);
  2779.     1041: TranslateWindow(wnd, translateDictionary.Translate('Match &case'), True);
  2780.     65535:
  2781.       begin
  2782.         case counter of
  2783.           0: TranslateWindow(wnd, translateDictionary.Translate('Fi&nd what:'), True);
  2784.           1: TranslateWindow(wnd, translateDictionary.Translate('Re&place with:'), True);
  2785.         end;
  2786.         Inc(counter);
  2787.       end;
  2788.   end;
  2789.  
  2790.   { Translates the child controls }
  2791.  
  2792.   EnumChildWindows(wnd, @IvTranslateReplaceDialog, 0);
  2793. end;
  2794.  
  2795. function IvDialogHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
  2796. var
  2797.   Width: Integer;
  2798.   Rect: TRect;
  2799. begin
  2800.   Result := 0;
  2801.   try
  2802.     case Msg of
  2803.       WM_INITDIALOG:
  2804.         begin
  2805.           if ComboBox <> nil then
  2806.           begin
  2807.             ComboBox.CreateWnd(Wnd, EditControlId);
  2808.             ComboBox := nil;
  2809.           end;
  2810.           if HookCtl3D then
  2811.           begin
  2812.             Subclass3DDlg(Wnd, CTL3D_ALL);
  2813.             SetAutoSubClass(True);
  2814.           end;
  2815.           GetWindowRect(Wnd, Rect);
  2816.           Width := Rect.Right - Rect.Left;
  2817.           SetWindowPos(Wnd, 0,
  2818.             (GetSystemMetrics(SM_CXSCREEN) - Width) div 2,
  2819.             (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
  2820.             0, 0, SWP_NOACTIVATE + SWP_NOSIZE + SWP_NOZORDER);
  2821.           Result := 1;
  2822.         end;
  2823.  
  2824.       WM_DESTROY:
  2825.         if HookCtl3D then
  2826.           SetAutoSubClass(False);
  2827.  
  2828.       WM_CTLCOLOR:
  2829.         if HookCtl3D and (@Ctl3DCtlColorEx <> nil) then
  2830.           Result := Ctl3DCtlColorEx(Wnd, Msg, WParam, LParam);
  2831.  
  2832.       WM_ACTIVATE:
  2833.         if WParam = WA_ACTIVE then
  2834.           translateFunction(Wnd, 0);
  2835.  
  2836.       WM_NCACTIVATE,
  2837.       WM_NCPAINT,
  2838.       WM_SETTEXT:
  2839.         if HookCtl3D and (@Ctl3DDlgFramePaint <> nil) then
  2840.         begin
  2841.           { The following fixes a Ctrl3D bug under Windows NT }
  2842.           if (GetWinFlags and $4000 <> 0) and (Msg = WM_SETTEXT) and
  2843.             (DialogTitle <> nil)
  2844.           then
  2845.             LParam := Longint(DialogTitle);
  2846.           SetWindowLong(
  2847.             Wnd,
  2848.             DWL_MSGRESULT,
  2849.             Ctl3DDlgFramePaint(Wnd, Msg, WParam, LParam));
  2850.           Result := 1;
  2851.         end;
  2852.     end;
  2853.   except
  2854.     Application.HandleException(nil);
  2855.   end;
  2856. end;
  2857.  
  2858. function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
  2859. type
  2860.   TDialogFunc = function(var DialogData): Bool;
  2861. var
  2862.   ActiveWindow: HWnd;
  2863.   WindowList: Pointer;
  2864. begin
  2865.   ActiveWindow := GetActiveWindow;
  2866.   WindowList := DisableTaskWindows(0);
  2867.   try
  2868.     Result := TDialogFunc(DialogFunc)(DialogData);
  2869.   finally
  2870.     EnableTaskWindows(WindowList);
  2871.     SetActiveWindow(ActiveWindow);
  2872.   end;
  2873. end;
  2874.  
  2875. function ValidHandle(Handle: THandle): Boolean;
  2876. var
  2877.   Count: Cardinal;
  2878. begin
  2879.   Result := IsBadWritePtr(Ptr(Handle, 0), Count);
  2880. end;
  2881.  
  2882. { TIvDlgControl }
  2883.  
  2884. constructor TIvDlgControl.Create(Owner: TIvComboButton);
  2885. begin
  2886.   inherited Create;
  2887.   FObjectInstance := MakeObjectInstance(MainWndProc);
  2888.   FOwner := Owner;
  2889. end;
  2890.  
  2891. destructor TIvDlgControl.Destroy;
  2892. begin
  2893.   FreeObjectInstance(FObjectInstance);
  2894.   inherited Destroy;
  2895. end;
  2896.  
  2897. procedure TIvDlgControl.DefaultHandler(var msg);
  2898. begin
  2899.   if (FHandle <> 0) and (FDefWndProc <> nil) then
  2900.     with TMessage(msg) do
  2901.       Result := CallWindowProc(FDefWndProc, FHandle, Msg, wParam, lParam);
  2902. end;
  2903.  
  2904. procedure TIvDlgControl.MainWndProc(var msg: TMessage);
  2905. begin
  2906.   try
  2907.     WndProc(msg);
  2908.   except
  2909.     Application.HandleException(Self);
  2910.   end;
  2911. end;
  2912.  
  2913. procedure TIvDlgControl.SetVisible(Value: Boolean);
  2914. const
  2915.   Visble: array[Boolean] of Word = (
  2916.     SWP_HIDEWINDOW or SWP_NOMOVE or SWP_NOSIZE,
  2917.     SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE);
  2918. var
  2919.   Wnd: HWND;
  2920. begin
  2921.   if Value <> FVisible then
  2922.   begin
  2923.     FVisible := Value;
  2924.     if FVisible then
  2925.       Wnd := HWND_TOPMOST
  2926.     else Wnd := HWND_NOTOPMOST;
  2927.     SetWindowPos(FHandle, Wnd, 0, 0, 0, 0, Visble[FVisible]);
  2928.   end;
  2929. end;
  2930.  
  2931. procedure TIvDlgControl.WndProc(var msg: TMessage);
  2932. begin
  2933.   Dispatch(msg);
  2934. end;
  2935.  
  2936. procedure TIvDlgControl.WMNCDestroy(var msg: TWMNCDestroy);
  2937. begin
  2938.   inherited;
  2939.   FHandle := 0;
  2940. end;
  2941.  
  2942. { TIvDlgEditControl }
  2943.  
  2944. procedure TIvDlgEditControl.Init;
  2945. begin
  2946.   FHandle := FOwner.FEditWnd;
  2947.   FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
  2948.     Longint(FObjectInstance)));
  2949. end;
  2950.  
  2951. procedure TIvDlgEditControl.DefaultHandler(var msg);
  2952. begin
  2953.   with TMessage(msg) do
  2954.     case Msg of
  2955.       WM_KEYDOWN, WM_SYSKEYDOWN:
  2956.         if wParam in [VK_UP, VK_DOWN] then
  2957.         begin
  2958.           if not FOwner.FDropListBox.FVisible and (wParam = VK_DOWN) and
  2959.             (lParam and $20000000 <> 0) then
  2960.           begin
  2961.             FOwner.DropDown;
  2962.           end
  2963.           else
  2964.             SendMessage(FOwner.FDropListBox.FHandle, Msg, WParam, LParam);
  2965.           Exit;
  2966.         end;
  2967.     end;
  2968.  
  2969.   inherited DefaultHandler(msg);
  2970. end;
  2971.  
  2972. procedure TIvDlgEditControl.WMKillFocus(var msg: TWMKillFocus);
  2973. begin
  2974.   FOwner.Closeup;
  2975.   inherited;
  2976. end;
  2977.  
  2978. { TIvCommonDlg }
  2979.  
  2980. procedure TIvCommonDlg.Init;
  2981. begin
  2982.   FHandle := GetParent(FOwner.FHandle);
  2983.   FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
  2984.     Longint(FObjectInstance)));
  2985. end;
  2986.  
  2987. procedure TIvCommonDlg.WMLButtonDown(var msg: TWMLButtonDown);
  2988. begin
  2989.   FOwner.CloseUp;
  2990.   inherited;
  2991. end;
  2992.  
  2993. procedure TIvCommonDlg.WMNCLButtonDown(var msg: TWMNCLButtonDown);
  2994. begin
  2995.   FOwner.CloseUp;
  2996.   inherited;
  2997. end;
  2998.  
  2999. { TIvDropListBox }
  3000.  
  3001. procedure TIvDropListBox.Init;
  3002. begin
  3003.   FHandle := CreateWindow('LISTBOX', '', WS_CHILD or LBS_HASSTRINGS or
  3004.     WS_VSCROLL or WS_BORDER or LBS_NOTIFY, 0, 0, 0, 0, FOwner.FHandle, $FFFF,
  3005.     HInstance, nil);
  3006.   if FHandle <> 0 then
  3007.   begin
  3008.     FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
  3009.       Longint(FObjectInstance)));
  3010.     SetParent(FHandle, 0);
  3011.     CallWindowProc(FDefWndProc, FHandle, WM_SETFOCUS, 0, 0);
  3012.   end
  3013.   else
  3014.     raise EOutOfResources.Create(LoadStr(SWindowCreate));
  3015. end;
  3016.  
  3017. procedure TIvDropListBox.WMLButtonUp(var msg: TWMLButtonUp);
  3018. begin
  3019.   inherited;
  3020.   FOwner.CloseUp;
  3021. end;
  3022.  
  3023. { File Common dialog ComboBox wrapper }
  3024.  
  3025. const
  3026.   WndClassName = 'DropListButton';
  3027.   ButtonWidth = 17;
  3028.  
  3029. constructor TIvComboButton.Create(Owner: TIvOpenDialog);
  3030. begin
  3031.   inherited Create;
  3032.   FOpenDialog := Owner;
  3033.   FObjectInstance := MakeObjectInstance(WndProc);
  3034.   FCanvas := TCanvas.Create;
  3035.   FGlyph := TBitmap.Create;
  3036.   FGlyph.Handle := LoadBitmap(0, PChar(OBM_COMBO));
  3037.   FDropListBox := TIvDropListBox.Create(Self);
  3038.   FEditControl := TIvDlgEditControl.Create(Self);
  3039.   FDlg := TIvCommonDlg.Create(Self);
  3040. end;
  3041.  
  3042. destructor TIvComboButton.Destroy;
  3043. begin
  3044.   FreeObjectInstance(FObjectInstance);
  3045.   FCanvas.Free;
  3046.   FGlyph.Free;
  3047.   FDropListBox.Free;
  3048.   FEditControl.Free;
  3049.   FDlg.Free;
  3050.   inherited Destroy;
  3051. end;
  3052.  
  3053. procedure TIvComboButton.Closeup;
  3054. begin
  3055.   FDropListBox.SetVisible(False);
  3056. end;
  3057.  
  3058. procedure TIvComboButton.DropDown;
  3059. var
  3060.   EditText: array[Byte] of Char;
  3061.   CurSel: Integer;
  3062.  
  3063.   procedure AdjustDropDown(CtrlWnd: HWnd);
  3064.   var
  3065.     DC: HDC;
  3066.     SaveFont: HFONT;
  3067.     I, W, ItemCount, ListWidth, MaxWidth: Integer;
  3068.     Metrics: TTextMetric;
  3069.     EditSize, ButtonSize: TRect;
  3070.     EditWnd, Wnd: HWnd;
  3071.     Height, Top: Integer;
  3072.  
  3073.     function TextWidth(const S: string): Integer;
  3074.     var
  3075.       C: array[Byte] of Char;
  3076.       Size: TSize;
  3077.     begin
  3078.       GetTextExtentPoint(DC, StrPCopy(C, S), Length(S), Size);
  3079.       Result := Size.cX;
  3080.     end;
  3081.  
  3082.   begin
  3083.     DC := CreateCompatibleDC(0);
  3084.     SaveFont := SelectObject(DC, SendMessage(CtrlWnd, WM_GETFONT, 0, 0));
  3085.     GetTextMetrics(DC, Metrics);
  3086.     try
  3087.       ItemCount := FOpenDialog.FHistoryList.Count;
  3088.       if ItemCount < 1 then ItemCount := 1;
  3089.       if ItemCount > 8 then ItemCount := 8;
  3090.       Wnd := GetParent(FHandle);
  3091.       GetWindowRect(FEditWnd, EditSize);
  3092.       GetWindowRect(FHandle, ButtonSize);
  3093.       ListWidth := ButtonSize.Right - EditSize.Left;
  3094.       MaxWidth := ListWidth * 2;
  3095.       for I := 0 to FOpenDialog.FHistoryList.Count - 1 do
  3096.       begin
  3097.         W := TextWidth(FOpenDialog.FHistoryList[I]);
  3098.         if FOpenDialog.FHistoryList.Count > 8 then
  3099.           Inc(W, GetSystemMetrics(SM_CXVSCROLL));
  3100.         if (W > ListWidth) and (W < MaxWidth) then
  3101.           ListWidth := W;
  3102.       end;
  3103.       Height := Metrics.tmHeight * ItemCount + 2;
  3104.       Top  := EditSize.Top + (EditSize.Bottom - EditSize.Top) - 1;
  3105.       if (Top + Height) > Screen.height then
  3106.          Top := EditSize.Top - Height + 1;
  3107.       if Top < 0  then
  3108.          Top  := EditSize.Top + (EditSize.Bottom - EditSize.Top) - 1;
  3109.       SetWindowPos(CtrlWnd, 0, EditSize.Left, Top, ListWidth, Height, SWP_NOACTIVATE);
  3110.     finally
  3111.       SelectObject(DC, SaveFont);
  3112.       DeleteDC(DC);
  3113.     end;
  3114.   end;
  3115.  
  3116. begin
  3117.   if not FDropListBox.FVisible then
  3118.   begin
  3119.     AdjustDropDown(FDropListBox.FHandle);
  3120.     SetFocus(FEditWnd);
  3121.     GetWindowText(FEditWnd, EditText, SizeOf(EditText));
  3122.     CurSel := SendMessage(FDropListBox.FHandle, LB_FINDSTRINGEXACT, $FFFF, Longint(@EditText));
  3123.     SendMessage(FDropListBox.FHandle, LB_SETCURSEL, CurSel, 0);
  3124.     FDropListBox.SetVisible(True);
  3125.   end;
  3126. end;
  3127.  
  3128. procedure TIvComboButton.WMCommand(var msg: TWMCommand);
  3129. var
  3130.   CurSel: Integer;
  3131.   CurText: array[Byte] of Char;
  3132. begin
  3133.   with msg do
  3134.     if NotifyCode = LBN_SELCHANGE then
  3135.     begin
  3136.       CurSel := SendMessage(FDropListBox.FHandle, LB_GETCURSEL, 0, 0);
  3137.       if CurSel <> LB_ERR then
  3138.       begin
  3139.         SendMessage(FDropListBox.FHandle, LB_GETTEXT, CurSel, Longint(@CurText));
  3140.         SetWindowText(FEditWnd, CurText);
  3141.         SendMessage(FEditWnd, EM_SETSEL, 0, MakeLong(0, $FFFF));
  3142.       end;
  3143.     end;
  3144.   inherited;
  3145. end;
  3146.  
  3147. procedure TIvComboButton.WMDestroy(var msg: TWMDestroy);
  3148. begin
  3149.   inherited;
  3150.   if FDropListBox.FHandle <> 0 then
  3151.     DestroyWindow(FDropListBox.FHandle);
  3152. end;
  3153.  
  3154. procedure TIvComboButton.WMNCDestroy(var msg: TWMNCDestroy);
  3155. begin
  3156.   inherited;
  3157.   FHandle := 0;
  3158. end;
  3159.  
  3160. procedure TIvComboButton.WMPaint(var msg: TWMPaint);
  3161. var
  3162.   DC: HDC;
  3163.   PS: TPaintStruct;
  3164.   GlyphLeft, GlyphTop: Integer;
  3165.   ClientRect: TRect;
  3166.   Width, Height: Integer;
  3167. begin
  3168.   DC := msg.DC;
  3169.   if DC = 0 then
  3170.     DC := BeginPaint(FHandle, PS);
  3171.   try
  3172.     FCanvas.Handle := DC;
  3173.     try
  3174.       GetClientRect(FHandle, ClientRect);
  3175.       Width := ClientRect.Right;
  3176.       Height := ClientRect.Bottom;
  3177.       with FCanvas do
  3178.       begin
  3179.         Pen.Color := clWindowFrame;
  3180.         Brush.Color := clBtnFace;
  3181.         Rectangle(0, 0, Width, Height);
  3182.         if FDown then
  3183.           Pen.Color := clBtnShadow
  3184.         else
  3185.           Pen.Color := clBtnHighlight;
  3186.         MoveTo(1, Height - 2);
  3187.         LineTo(1, 1);
  3188.         LineTo(Width - 1, 1);
  3189.         GlyphLeft := (Width - FGlyph.Width) div 2;
  3190.         GlyphTop := (Height - FGlyph.Height) div 2;
  3191.         if FDown then
  3192.         begin
  3193.           Inc(GlyphLeft);
  3194.           Inc(GlyphTop);
  3195.         end else
  3196.         begin
  3197.           Pen.Color := clBtnShadow;
  3198.           MoveTo(1, Height - 2);
  3199.           LineTo(Width - 2, Height - 2);
  3200.           LineTo(Width - 2, 0);
  3201.         end;
  3202.         Draw(GlyphLeft, GlyphTop, FGlyph)
  3203.       end;
  3204.     finally
  3205.       FCanvas.Handle := 0;
  3206.     end;
  3207.   finally
  3208.     if msg.DC = 0 then
  3209.       EndPaint(FHandle, PS);
  3210.   end;
  3211. end;
  3212.  
  3213. procedure TIvComboButton.WMLButtonDown(var msg: TWMLButtonDown);
  3214. begin
  3215.   inherited;
  3216.   if FDropListBox.FVisible then
  3217.     CloseUp
  3218.   else
  3219.   begin
  3220.     DropDown;
  3221.     SetCapture(FHandle);
  3222.     FDown := True;
  3223.     FPressed := True;
  3224.     Repaint;
  3225.   end;
  3226. end;
  3227.  
  3228. procedure TIvComboButton.WMMouseMove(var msg: TWMMouseMove);
  3229. var
  3230.   NewDown: Boolean;
  3231.   P: TPoint;
  3232.   Rect: TRect;
  3233. begin
  3234.   inherited;
  3235.   if FPressed then
  3236.     with msg do
  3237.     begin
  3238.       GetClientRect(FHandle, Rect);
  3239.       NewDown := (XPos >= 0) and (YPos >= 0) and
  3240.         (XPos < Rect.Right) and (YPos < Rect.Bottom);
  3241.       if FDown <> NewDown then
  3242.       begin
  3243.         FDown := NewDown;
  3244.         Repaint;
  3245.       end;
  3246.       if not FDown and FDropListBox.FVisible then
  3247.       begin
  3248.         P := SmallPointToPoint(Pos);
  3249.         ClientToScreen(FHandle, P);
  3250.         GetWindowRect(FDropListBox.FHandle, Rect);
  3251.         if PtInRect(Rect, P) then
  3252.         begin
  3253.           SendMessage(FHandle, WM_LBUTTONUP, 0, 0);
  3254.           SendMessage(FDropListBox.FHandle, WM_LBUTTONDOWN, 0, 0);
  3255.         end;
  3256.       end;
  3257.     end;
  3258. end;
  3259.  
  3260. procedure TIvComboButton.WMLButtonUp(var msg: TWMLButtonUp);
  3261. begin
  3262.   inherited;
  3263.   if FPressed then
  3264.   begin
  3265.     ReleaseCapture;
  3266.     FDown := False;
  3267.     FPressed := False;
  3268.     Repaint;
  3269.   end;
  3270. end;
  3271.  
  3272. procedure TIvComboButton.CreateWnd(Dlg: HWnd; ControlID: Word);
  3273. const
  3274.   Gap = 8;
  3275. var
  3276.   EditSize: TRect;
  3277.   I: Integer;
  3278.   StringBuf: array[0..255] of Char;
  3279.   Font: HFont;
  3280. begin
  3281.   if Dlg <> 0 then
  3282.   begin
  3283.     RegisterClass;
  3284.     FEditWnd := GetDlgItem(Dlg, ControlID);
  3285.     if FEditWnd <> 0 then
  3286.     try
  3287.       GetWindowRect(FEditWnd, EditSize);
  3288.       ScreenToClient(Dlg, EditSize.TopLeft);
  3289.       ScreenToClient(Dlg, EditSize.BottomRight);
  3290.       Dec(EditSize.Right, ButtonWidth + Gap);
  3291.       SetWindowPos(FEditWnd, 0, 0, 0, EditSize.Right - EditSize.Left,
  3292.         EditSize.Bottom - EditSize.Top, SWP_NOMOVE);
  3293.       FHandle := CreateWindow(WndClassName, '', WS_CHILD or WS_VISIBLE,
  3294.         EditSize.Right + Gap, EditSize.Top, ButtonWidth, EditSize.Bottom - EditSize.Top,
  3295.         Dlg, $FFFF, HInstance, nil);
  3296.       if FHandle <> 0 then
  3297.       begin
  3298.         FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
  3299.           Longint(FObjectInstance)));
  3300.         FDropListBox.Init;
  3301.         FEditControl.Init;
  3302.         Font := SendMessage(Dlg, WM_GETFONT, 0, 0);
  3303.         SendMessage(FDropListBox.FHandle, WM_SETFONT, Font, 0);
  3304.         if FOpenDialog.FHistoryList <> nil then
  3305.           for I := 0 to FOpenDialog.FHistoryList.Count - 1 do
  3306.             SendMessage(FDropListBox.FHandle, LB_ADDSTRING, 0,
  3307.               Longint(StrPCopy(StringBuf, FOpenDialog.FHistoryList[I])));
  3308.       end
  3309.       else
  3310.         raise EOutOfResources.Create(LoadStr(SWindowCreate));
  3311.       FDlg.Init;
  3312.       UpdateWindow(FHandle);
  3313.     except
  3314.       if FHandle <> 0 then DestroyWindow(FHandle);
  3315.       raise;
  3316.     end;
  3317.   end;
  3318. end;
  3319.  
  3320. procedure TIvComboButton.RegisterClass;
  3321. var
  3322.   WndClass: TWndClass;
  3323.   ClassName: array[0..63] of Char;
  3324. begin
  3325.   if not GetClassInfo(HInstance, WndClassName, WndClass) then
  3326.   begin
  3327.     FillChar(WndClass, SizeOf(WndCLass), 0);
  3328.     with WndClass do
  3329.     begin
  3330.       style := CS_HREDRAW or CS_VREDRAW;
  3331.       lpfnWndProc := @DefWindowProc;
  3332.       hCursor := LoadCursor(0, IDC_ARROW);
  3333.       hbrBackground := COLOR_WINDOW + 1;
  3334.       lpszClassName := StrPCopy(ClassName, WndClassName);
  3335.     end;
  3336.     WndClass.hInstance := HInstance;
  3337.     if not WinProcs.RegisterClass(WndClass) then
  3338.       raise EOutOfResources.Create(LoadStr(SWindowClass));
  3339.   end;
  3340. end;
  3341.  
  3342. procedure TIvComboButton.Repaint;
  3343. begin
  3344.   InvalidateRect(FHandle, nil, False);
  3345.   UpdateWindow(FHandle);
  3346. end;
  3347.  
  3348. procedure TIvComboButton.DefaultHandler(var msg);
  3349. begin
  3350.   if (FHandle <> 0) and (FDefWndProc <> nil) then
  3351.     with TMessage(msg) do
  3352.       Result := CallWindowProc(FDefWndProc, FHandle, Msg, wParam, lParam);
  3353. end;
  3354.  
  3355. procedure TIvComboButton.WndProc(var msg: TMessage);
  3356. begin
  3357.   try
  3358.     Dispatch(msg);
  3359.   except
  3360.     Application.HandleException(Self);
  3361.   end;
  3362. end;
  3363.  
  3364. { Common Dialog main window manager }
  3365.  
  3366. type
  3367.   TIvCommonDialogList = class(TList)
  3368.   private
  3369.     function CheckHelpAndIsDialog(Code: Integer; WParam: Word;
  3370.       var Msg: TMsg): LongInt;
  3371.   public
  3372.     Hook: HHook;
  3373.     procedure Add(CommonDialog: TIvCommonDialog);
  3374.     procedure Remove(CommonDialog: TIvCommonDialog);
  3375.     destructor Destroy; override;
  3376.   end;
  3377.  
  3378. var
  3379.   CommonDialogList: TIvCommonDialogList;
  3380.  
  3381. function HelpFilterHook(Code: Integer; WParam: Word; LParam: Longint): LongInt; export;
  3382. begin
  3383.   try
  3384.     Result := 0;
  3385.     if (Code >= 0) and (WParam = MSGF_DIALOGBOX) then
  3386.       Result := CommonDialogList.CheckHelpAndIsDialog(Code, WParam, PMsg(LParam)^);
  3387.     if Result = 0 then
  3388.       Result := CallNextHookEx(CommonDialogList.Hook, Code, WParam, LParam);
  3389.   except
  3390.     Application.HandleException(nil);
  3391.   end;
  3392. end;
  3393.  
  3394. destructor TIvCommonDialogList.Destroy;
  3395. begin
  3396.   if Hook <> 0 then
  3397.   begin
  3398.     UnHookWindowsHookEx(Hook);
  3399.     Hook := 0;
  3400.   end;
  3401.   inherited Destroy;
  3402. end;
  3403.  
  3404. procedure TIvCommonDialogList.Add(CommonDialog: TIvCommonDialog);
  3405. begin
  3406.   if Count = 0 then
  3407.     Hook := SetWindowsHookEx(WH_MSGFILTER, HelpFilterHook,
  3408.       GetInstanceModule(HInstance), GetCurrentTask);
  3409.   inherited Add(CommonDialog);
  3410.   Application.HookMainWindow(CommonDialog.Message);
  3411. end;
  3412.  
  3413. procedure TIvCommonDialogList.Remove(CommonDialog: TIvCommonDialog);
  3414. begin
  3415.   inherited Remove(CommonDialog);
  3416.   Application.UnhookMainWindow(CommonDialog.Message);
  3417.   if Count = 0 then
  3418.   begin
  3419.     if Hook <> 0 then
  3420.     begin
  3421.       UnHookWindowsHookEx(Hook);
  3422.       Hook := 0;
  3423.     end;
  3424.   end;
  3425. end;
  3426.  
  3427. function TIvCommonDialogList.CheckHelpAndIsDialog(Code: Integer; WParam: Word;
  3428.   var Msg: TMsg): LongInt;
  3429. var
  3430.   OurWindow, DlgWindow, WorkWindow, HelpButton: HWND;
  3431.  
  3432.   function IsCorrectHelpKey: Boolean;
  3433.   begin
  3434.     Result := (Msg.wParam = VK_F1) and ((Msg.lParam and $00000004) = 0) and
  3435.       (GetKeyState(VK_CONTROL) >= 0) and (GetKeyState(VK_SHIFT) >= 0);
  3436.   end;
  3437.  
  3438.   procedure RetrieveHandles;
  3439.   begin
  3440.     OurWindow := 0;
  3441.     DlgWindow := 0;
  3442.     WorkWindow := Msg.hwnd;
  3443.     while WorkWindow <> 0 do
  3444.     begin
  3445.       DlgWindow := OurWindow;
  3446.       OurWindow := WorkWindow;
  3447.       WorkWindow := GetParent(WorkWindow);
  3448.     end;
  3449.   end;
  3450.  
  3451. begin
  3452.   Result := 0;
  3453.   RetrieveHandles;
  3454.   if (OurWindow <> 0) and (OurWindow = Application.Handle) and (DlgWindow <> 0) then
  3455.   begin
  3456.     if (Msg.Message = WM_KEYDOWN) and IsCorrectHelpKey then
  3457.     begin
  3458.       HelpButton := GetDlgItem(DlgWindow, pshHelp);
  3459.       if HelpButton <> 0 then
  3460.       begin
  3461.         PostMessage(DlgWindow, WM_COMMAND, pshHelp, MakeLong(BN_CLICKED,
  3462.           HelpButton));
  3463.         Result := 1;
  3464.       end;
  3465.     end;
  3466.   end;
  3467. end;
  3468.  
  3469. { TIvCommonDialog }
  3470.  
  3471. constructor TIvCommonDialog.Create(AOwner: TComponent);
  3472. begin
  3473.   inherited Create(AOwner);
  3474.   FCtl3D := True;
  3475. end;
  3476.  
  3477. function TIvCommonDialog.Message(var Msg: TMessage): Boolean;
  3478. begin
  3479.   Result := False;
  3480.   if (Msg.Msg = HelpMsg) and (FHelpContext <> 0) then
  3481.   begin
  3482.     Application.HelpContext(FHelpContext);
  3483.     Result := True;
  3484.   end;
  3485. end;
  3486.  
  3487. procedure TIvCommonDialog.InitDictionary;
  3488. begin
  3489.   if FDictionaryName <> '' then
  3490.     FDictionary := Dictionaries.FindDictionary(FDictionaryName);
  3491.  
  3492.   if FDictionary = nil then
  3493.     FDictionary := Dictionaries[0];
  3494. end;
  3495.  
  3496. procedure TIvCommonDialog.SetDictionary(value: TIvDictionary);
  3497. begin
  3498.   if value <> FDictionary then
  3499.   begin
  3500.     FDictionary := value;
  3501.     if FDictionary <> nil then
  3502.       FDictionaryName := FDictionary.DictionaryName;
  3503.   end;
  3504. end;
  3505.  
  3506. procedure TIvCommonDialog.SetDictionaryName(const value: String);
  3507. begin
  3508.   if FDictionaryName <> value then
  3509.   begin
  3510.     Dictionary := Dictionaries.FindDictionary(value);
  3511.     FDictionaryName := value;
  3512.   end;
  3513. end;
  3514.  
  3515. { TIvOpenDialog }
  3516.  
  3517. constructor TIvOpenDialog.Create(AOwner: TComponent);
  3518. begin
  3519.   inherited Create(AOwner);
  3520.   FHistoryList := TStringList.Create;
  3521.   FFiles := TStringList.Create;
  3522.   FComboBox := TIvComboButton.Create(Self);
  3523.   FFilter := NullStr;
  3524.   FInitialDir := NullStr;
  3525.   FTitle := NullStr;
  3526.   FFilterIndex := 1;
  3527.   FFileEditStyle := fsEdit;
  3528. end;
  3529.  
  3530. destructor TIvOpenDialog.Destroy;
  3531. begin
  3532.   DisposeStr(FTitle);
  3533.   DisposeStr(FInitialDir);
  3534.   DisposeStr(FFilter);
  3535.   FComboBox.Free;
  3536.   FHistoryList.Free;
  3537.   FFiles.Free;
  3538.   inherited Destroy;
  3539. end;
  3540.  
  3541. function TIvOpenDialog.DoExecute(Func: Pointer): Bool;
  3542. const
  3543.   OpenOptions: array [TOpenOption] of Longint = (
  3544.     OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
  3545.     OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
  3546.     OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
  3547.     OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
  3548.     OFN_NOTEXTFILECREATE);
  3549. var
  3550.   Option: TOpenOption;
  3551.   OpenFilename: TOpenFilename;
  3552.   CDefaultExt: array[0..SizeOf(TFileExt) - 1] of Char;
  3553.   CInitialDir: array[0..79] of Char;
  3554.   CTitle: array[0..79] of Char;
  3555.   CFilter: array[0..257] of Char;
  3556.  
  3557.   function StrFilterCopy(P: PChar; const S: string): PChar;
  3558.   begin
  3559.     Result := nil;
  3560.     if S <> '' then
  3561.     begin
  3562.       Result := StrPCopy(P, S);
  3563.       while P^ <> #0 do
  3564.       begin
  3565.         if P^ = '|' then P^ := #0;
  3566.         Inc(P);
  3567.       end;
  3568.       Inc(P);
  3569.       P^ := #0;
  3570.     end;
  3571.   end;
  3572.  
  3573.   function ProcessIndividualItem(var P: PChar): string;
  3574.   var
  3575.     I: Integer;
  3576.   begin
  3577.     I := 0;
  3578.     while (P[I] <> #0) and (P[I] <> ' ') do
  3579.     begin
  3580.       Result[I + 1] := P[I];
  3581.       Inc(I);
  3582.     end;
  3583.     Result[0] := Char(I);
  3584.     if P[I] = #0 then Inc(P, I) else Inc(P, I + 1);
  3585.   end;
  3586.  
  3587.   procedure ProcessMultipleSelection(P: PChar);
  3588.   var
  3589.     DirPart, FilePart: String;
  3590.   begin
  3591.     DirPart := ProcessIndividualItem(P);
  3592.     if Length(DirPart) <> 0 then
  3593.     begin
  3594.       repeat
  3595.         FilePart := ProcessIndividualItem(P);
  3596.         if FilePart <> '' then
  3597.           FFiles.Add(DirPart + '\' + FilePart);
  3598.       until FilePart = '';
  3599.       if FFiles.Count = 0 then
  3600.         FFiles.Add(DirPart);
  3601.     end;
  3602.   end;
  3603.  
  3604. begin
  3605.   FFiles.Clear;
  3606.   FillChar(OpenFileName, SizeOf(OpenFileName), 0);
  3607.   with OpenFilename do
  3608.   begin
  3609.     lStructSize := SizeOf(TOpenFilename);
  3610.     hInstance := System.HInstance;
  3611.     lpstrFilter := StrFilterCopy(CFilter, FFilter^);
  3612.     nFilterIndex := FFilterIndex;
  3613.     if ofAllowMultiSelect in FOptions then
  3614.       nMaxFile := $1000
  3615.     else
  3616.       nMaxFile := sizeof(TFileName);
  3617.     try
  3618.       GetMem(lpstrFile, nMaxFile + 1);
  3619.       FillChar(lpstrFile^, nMaxFile + 1, 0);
  3620.       StrPCopy(lpstrFile, FFileName);
  3621.       lpstrInitialDir := StrPLCopy(CInitialDir, FInitialDir^,
  3622.         SizeOf(CInitialDir) - 1);
  3623.       lpstrTitle := StrPLCopy(CTitle, FTitle^, SizeOf(CTitle) - 1);
  3624.       if Length(FTitle^) > 0 then DialogTitle := lpstrTitle;
  3625.       Flags := OFN_ENABLEHOOK;
  3626.       for Option := Low(Option) to High(Option) do
  3627.         if Option in FOptions then
  3628.           Flags := Flags or OpenOptions[Option];
  3629.       lpstrDefExt := StrPCopy(CDefaultExt, FDefaultExt);
  3630.       lpfnHook := IvDialogHook;
  3631.       if Func = @GetOpenFileName then
  3632.         translateFunction := IvTranslateOpenDialog
  3633.       else
  3634.         translateFunction := IvTranslateSaveDialog;
  3635.       HookCtl3D := FCtl3D;
  3636.       HookColorDlg := False;
  3637.       if FFileEditStyle = fsComboBox then
  3638.         ComboBox := FComboBox
  3639.       else ComboBox := nil;
  3640.       CommonDialogList.Add(Self);
  3641.       hWndOwner := Application.Handle;
  3642.       if FDictionary = nil then
  3643.         translateDictionary := nil
  3644.       else
  3645.         translateDictionary := FDictionary;
  3646.       Result := TaskModalDialog(Func, OpenFileName);
  3647.       DialogTitle := nil;
  3648.       CommonDialogList.Remove(Self);
  3649.       if Result then
  3650.       begin
  3651.         ProcessMultipleSelection(lpstrFile);
  3652.         FFileName := FFiles.Strings[0];
  3653.         if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
  3654.           FOptions := FOptions + [ofExtensionDifferent]
  3655.         else
  3656.           FOptions := FOptions - [ofExtensionDifferent];
  3657.         if (Flags and OFN_READONLY) <> 0 then
  3658.           FOptions := FOptions + [ofReadOnly]
  3659.         else
  3660.           FOptions := FOptions - [ofReadOnly];
  3661.       end;
  3662.     finally
  3663.       FreeMem(lpstrFile, nMaxFile + 1);
  3664.     end;
  3665.   end;
  3666. end;
  3667.  
  3668. function TIvOpenDialog.GetFilter: string;
  3669. begin
  3670.   Result := FFilter^;
  3671. end;
  3672.  
  3673. function TIvOpenDialog.GetInitialDir: string;
  3674. begin
  3675.   Result := FInitialDir^;
  3676. end;
  3677.  
  3678. function TIvOpenDialog.GetTitle: string;
  3679. begin
  3680.   Result := FTitle^;
  3681. end;
  3682.  
  3683. procedure TIvOpenDialog.SetFilter(const AFilter: String);
  3684. begin
  3685.   AssignStr(FFilter, AFilter);
  3686. end;
  3687.  
  3688. procedure TIvOpenDialog.SetInitialDir(const AInitialDir: String);
  3689.  
  3690.   function TrimBackslash(const Dir: string): string;
  3691.   begin
  3692.    if (Dir = '') or ((Length(Dir) = 3) and (Dir[3] = '\')) or
  3693.      (Dir[Length(Dir)] <> '\') then
  3694.       Result := Dir
  3695.     else if Dir[Length(Dir)] = '\' then
  3696.       Result := Copy(Dir, 1, Length(Dir) - 1);
  3697.   end;
  3698.  
  3699. begin
  3700.   AssignStr(FInitialDir, TrimBackslash(AInitialDir));
  3701. end;
  3702.  
  3703. procedure TIvOpenDialog.SetHistoryList(Value: TStrings);
  3704. begin
  3705.   FHistoryList.Assign(Value);
  3706. end;
  3707.  
  3708. function TIvOpenDialog.GetFiles: TStrings;
  3709. begin
  3710.   Result := FFiles;
  3711. end;
  3712.  
  3713. procedure TIvOpenDialog.SetTitle(const ATitle: String);
  3714. begin
  3715.   AssignStr(FTitle, ATitle);
  3716. end;
  3717.  
  3718. function TIvOpenDialog.Execute: Boolean;
  3719. begin
  3720.   InitDictionary;
  3721.   Result := DoExecute(@GetOpenFileName);
  3722. end;
  3723.  
  3724. { TIvSaveDialog }
  3725.  
  3726. function TIvSaveDialog.Execute: Boolean;
  3727. begin
  3728.   InitDictionary;
  3729.   Result := DoExecute(@GetSaveFileName);
  3730. end;
  3731.  
  3732. { TIvColorDialog }
  3733.  
  3734. constructor TIvColorDialog.Create(AOwner: TComponent);
  3735. var
  3736.   I: Integer;
  3737. begin
  3738.   inherited Create(AOwner);
  3739.   FCtl3D := False;
  3740.   FCustomColors := TStringList.Create;
  3741. end;
  3742.  
  3743. destructor TIvColorDialog.Destroy;
  3744. begin
  3745.   FCustomColors.Free;
  3746.   inherited Destroy;
  3747. end;
  3748.  
  3749. function TIvColorDialog.Execute: Boolean;
  3750. const
  3751.   DialogOptions: array[TColorDialogOption] of LongInt = (
  3752.     CC_FULLOPEN, CC_PREVENTFULLOPEN, CC_SHOWHELP);
  3753. var
  3754.   ChooseColorRec: TChooseColor;
  3755.   Option: TColorDialogOption;
  3756.   CustomColorsArray: TCustomColors;
  3757.   ColorPrefix, ColorTags: string;
  3758.  
  3759.   procedure GetCustomColorsArray;
  3760.   var
  3761.     I: Integer;
  3762.   begin
  3763.     if (Length(ColorPrefix) > 0) and (Length(ColorTags) > 0) then
  3764.       for I := 1 to MaxCustomColors do
  3765.         FCustomColors.Values[ColorPrefix + ColorTags[I]] :=
  3766.           Format('%x', [CustomColorsArray[I - 1]]);
  3767.   end;
  3768.  
  3769.   procedure SetCustomColorsArray;
  3770.   var
  3771.     Value: string;
  3772.     I: Integer;
  3773.   begin
  3774.     if (Length(ColorPrefix) > 0) and (Length(ColorTags) > 0) then
  3775.       for I := 1 to MaxCustomColors do
  3776.       begin
  3777.         Value := FCustomColors.Values[ColorPrefix + ColorTags[I]];
  3778.         if Value <> '' then CustomColorsArray[I - 1] := StrToInt('$' + Value)
  3779.         else CustomColorsArray[I - 1] := -1;
  3780.       end;
  3781.   end;
  3782.  
  3783. begin
  3784.   InitDictionary;
  3785.   
  3786.   with ChooseColorRec do
  3787.   begin
  3788.     lStructSize := SizeOf(ChooseColorRec);
  3789.     rgbResult := ColorToRGB(FColor);
  3790.     lpCustColors := @CustomColorsArray;
  3791.     Flags := CC_RGBINIT or CC_ENABLEHOOK;
  3792.     for Option := Low(Option) to High(Option) do
  3793.       if Option in FOptions then
  3794.         Flags := Flags or DialogOptions[Option];
  3795.     ColorPrefix := 'Color';
  3796.     ColorTags := 'ABCDEFGHIJKLMNOP';
  3797.     SetCustomColorsArray;
  3798.     lpfnHook := IvDialogHook;
  3799.     translateFunction := IvTranslateColorDialog;
  3800.     HookCtl3D := FCtl3D;
  3801.     HookColorDlg := True;
  3802.     CommonDialogList.Add(Self);
  3803.     hWndOwner := Application.Handle;
  3804.     if FDictionary = nil then
  3805.       translateDictionary := nil
  3806.     else
  3807.       translateDictionary := FDictionary;
  3808.     Result := TaskModalDialog(@ChooseColor, ChooseColorRec);
  3809.     CommonDialogList.Remove(Self);
  3810.     GetCustomColorsArray;
  3811.     if Result then FColor := rgbResult;
  3812.   end;
  3813. end;
  3814.  
  3815. procedure TIvColorDialog.SetCustomColors(Value: TStrings);
  3816. begin
  3817.   FCustomColors.Assign(Value);
  3818. end;
  3819.  
  3820. { TIvFontDialog }
  3821.  
  3822. constructor TIvFontDialog.Create(AOwner: TComponent);
  3823. begin
  3824.   inherited Create(AOwner);
  3825.   FFont := TFont.Create;
  3826.   FOptions := [fdEffects];
  3827. end;
  3828.  
  3829. destructor TIvFontDialog.Destroy;
  3830. begin
  3831.   FFont.Free;
  3832.   inherited Destroy;
  3833. end;
  3834.  
  3835. procedure TIvFontDialog.UpdateFromLogFont(const LogFont: TLogFont);
  3836. var
  3837.   Style: TFontStyles;
  3838. begin
  3839.   with LogFont do
  3840.   begin
  3841.     Font.Name := StrPas(LogFont.lfFaceName);
  3842.     Font.Height := LogFont.lfHeight;
  3843.     Style := [];
  3844.     with LogFont do
  3845.     begin
  3846.       if lfWeight > FW_REGULAR then Include(Style, fsBold);
  3847.       if lfItalic <> 0 then Include(Style, fsItalic);
  3848.       if lfUnderline <> 0 then Include(Style, fsUnderline);
  3849.       if lfStrikeOut <> 0 then Include(Style, fsStrikeOut);
  3850.     end;
  3851.     Font.Style := Style;
  3852.   end;
  3853. end;
  3854.  
  3855. procedure TIvFontDialog.Apply(Wnd: HWND);
  3856. begin
  3857.   if Assigned(FOnApply) then FOnApply(Self, Wnd);
  3858. end;
  3859.  
  3860. procedure TIvFontDialog.DoApply(Wnd: HWND);
  3861. const
  3862.   IDCOLORCMB = $473;
  3863. var
  3864.   I: Integer;
  3865.   LogFont: TLogFont;
  3866. begin
  3867.   { Retrieve current state from dialog }
  3868.   SendMessage(Wnd, WM_CHOOSEFONT_GETLOGFONT, 0, LongInt(@LogFont));
  3869.   UpdateFromLogFont(LogFont);
  3870.   I := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETCURSEL, 0, 0);
  3871.   if I <> CB_ERR then
  3872.     Font.Color := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETITEMDATA, I, 0);
  3873.   try
  3874.     Apply(Wnd);
  3875.   except
  3876.     Application.HandleException(Self);
  3877.   end;
  3878. end;
  3879.  
  3880. procedure TIvFontDialog.SetFont(Value: TFont);
  3881. begin
  3882.   FFont.Assign(Value);
  3883. end;
  3884.  
  3885. const
  3886.   IDAPPLYBTN = $402;
  3887.  
  3888. var
  3889.   FontDlg: TIvFontDialog;
  3890.  
  3891. function IvFontDialogHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
  3892. begin
  3893.   if (Msg = WM_COMMAND) and (wParam = IDAPPLYBTN) and
  3894.     (LongRec(lParam).Hi = BN_CLICKED) then
  3895.   begin
  3896.     FontDlg.DoApply(Wnd);
  3897.     Result := 1;
  3898.   end
  3899.   else
  3900.     Result := IvDialogHook(Wnd, Msg, wParam, lParam);
  3901. end;
  3902.  
  3903. function TIvFontDialog.Execute: Boolean;
  3904. const
  3905.   FontOptions: array[TFontDialogOption] of LongInt = (
  3906.     CF_ANSIONLY, CF_TTONLY, CF_EFFECTS, CF_FIXEDPITCHONLY, CF_FORCEFONTEXIST,
  3907.     CF_NOFACESEL, CF_NOOEMFONTS, CF_NOSIMULATIONS, CF_NOSIZESEL, CF_NOSTYLESEL,
  3908.     CF_NOVECTORFONTS, CF_SHOWHELP, CF_WYSIWYG, CF_LIMITSIZE, CF_SCALABLEONLY);
  3909.   Devices: array[TFontDialogDevice] of LongInt = (
  3910.     CF_SCREENFONTS, CF_PRINTERFONTS, CF_BOTH);
  3911. var
  3912.   ChooseFontRec: TChooseFont;
  3913.   LogFont: TLogFont;
  3914.   Option: TFontDialogOption;
  3915.   OldFontDlg: TIvFontDialog;
  3916. begin
  3917.   InitDictionary;
  3918.   
  3919.   with ChooseFontRec do
  3920.   begin
  3921.     lStructSize := SizeOf(ChooseFontRec);
  3922.     hDC := 0;
  3923.     if FDevice <> fdScreen then hDC := Printer.Handle;
  3924.     lpLogFont := @LogFont;
  3925.     GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
  3926.     Flags := (CF_INITTOLOGFONTSTRUCT or CF_ENABLEHOOK) or Devices[FDevice];
  3927.     for Option := Low(Option) to High(Option) do
  3928.       if Option in FOptions then
  3929.         Flags := Flags or FontOptions[Option];
  3930.     if Assigned(FOnApply) then
  3931.       Flags := Flags or CF_APPLY;
  3932.     rgbColors := Font.Color;
  3933.     lCustData := 0;
  3934.     OldFontDlg := FontDlg;
  3935.     FontDlg := Self;
  3936.     lpfnHook := IvFontDialogHook;
  3937.     translateFunction := IvTranslateFontDialog;
  3938.     HookCtl3D := FCtl3D;
  3939.     HookColorDlg := False;
  3940.     nSizeMin := FMinFontSize;
  3941.     nSizeMax := FMaxFontSize;
  3942.     if nSizeMin > nSizeMax then Flags := Flags and (not CF_LIMITSIZE);
  3943.     CommonDialogList.Add(Self);
  3944.     hWndOwner := Application.Handle;
  3945.     if FDictionary = nil then
  3946.       translateDictionary := nil
  3947.     else
  3948.       translateDictionary := FDictionary;
  3949.     Result := TaskModalDialog(@ChooseFont, ChooseFontRec);
  3950.     FontDlg := OldFontDlg;
  3951.     CommonDialogList.Remove(Self);
  3952.     if Result then
  3953.     begin
  3954.       UpdateFromLogFont(LogFont);
  3955.       Font.Color := rgbColors;
  3956.     end;
  3957.   end;
  3958. end;
  3959.  
  3960. { TPrinterSetupDialog }
  3961.  
  3962. type
  3963.   PDevNamesRec = ^TDevNamesRec;
  3964.   TDevNamesRec = record
  3965.     DriverOfs: Word;
  3966.     DeviceOfs: Word;
  3967.     PortOfs: Word;
  3968.     Reserved: Word;
  3969.   end;
  3970.  
  3971. procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
  3972. var
  3973.   DevRec: PDevNamesRec;
  3974.   Device, Driver, Port: array[0..79] of Char;
  3975.   P: PChar;
  3976. begin
  3977.   Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  3978.   if DeviceMode <> 0 then
  3979.   begin
  3980.     DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNamesRec) +
  3981.       StrLen(Device) + StrLen(Driver) + StrLen(Port) * 3);
  3982.     DevRec := Ptr(DeviceNames, 0);
  3983.     P := PChar(DevRec) + SizeOf(TDevNamesRec);
  3984.     with DevRec^ do
  3985.     begin
  3986.       DeviceOfs := PtrRec(P).Ofs;
  3987.       P := StrECopy(P, Device) + 1;
  3988.       DriverOfs := PtrRec(P).Ofs;
  3989.       P := StrECopy(P, Driver) + 1;
  3990.       PortOfs := PtrRec(P).Ofs;
  3991.       StrCopy(P, Port);
  3992.     end;
  3993.   end;
  3994. end;
  3995.  
  3996. procedure SetPrinter(DeviceMode, DeviceNames: THandle);
  3997. var
  3998.   DevRec: PDevNamesRec;
  3999. begin
  4000.   DevRec := Ptr(DeviceNames, 0);
  4001.   with DevRec^ do
  4002.     Printer.SetPrinter(@PChar(DevRec)[DeviceOfs],
  4003.       @PChar(DevRec)[DriverOfs], @PChar(DevRec)[PortOfs], DeviceMode);
  4004.   GlobalFree(DeviceNames);
  4005. end;
  4006.  
  4007. procedure TIvPrinterSetupDialog.Execute;
  4008. var
  4009.   PrintDlgRec: TPrintDlg;
  4010.   hTmpDevMode: THandle;
  4011. begin
  4012.   InitDictionary;
  4013.   
  4014.   FillChar(PrintDlgRec, SizeOf(PrintDlgRec), 0);
  4015.   with PrintDlgRec do
  4016.   begin
  4017.     lStructSize := SizeOf(PrintDlgRec);
  4018.     hInstance := System.HInstance;
  4019.     GetPrinter(hDevMode, hDevNames);
  4020.     hTmpDevMode := hDevMode;
  4021.     Flags := PD_ENABLESETUPHOOK or PD_PRINTSETUP;
  4022.     lpfnSetupHook := IvDialogHook;
  4023.     translateFunction := IvTranslatePrinterSetupDialog;
  4024.     HookCtl3D := FCtl3D;
  4025.     HookColorDlg := False;
  4026.     CommonDialogList.Add(Self);
  4027.     if FDictionary = nil then
  4028.       translateDictionary := nil
  4029.     else
  4030.       translateDictionary := FDictionary;
  4031.     hWndOwner := Application.Handle;
  4032.     if TaskModalDialog(@PrintDlg, PrintDlgRec) then
  4033.       SetPrinter(hDevMode, hDevNames)
  4034.     else
  4035.     begin
  4036.       if (hTmpDevMode <> hDevMode) and ValidHandle(hDevMode) then
  4037.         GlobalFree(hDevMode);
  4038.       if ValidHandle(hDevNames) then GlobalFree(hDevNames);
  4039.     end;
  4040.     CommonDialogList.Remove(Self);
  4041.   end;
  4042. end;
  4043.  
  4044. { TIvPrinterDialog }
  4045.  
  4046. function TIvPrintDialog.Execute: Boolean;
  4047. const
  4048.   APrintRange: array[TPrintRange] of Integer =
  4049.     (PD_ALLPAGES, PD_SELECTION, PD_PAGENUMS);
  4050. var
  4051.   PrintDlgRec: TPrintDlg;
  4052.   F: LongInt;
  4053. begin
  4054.   InitDictionary;
  4055.   
  4056.   FillChar(PrintDlgRec, SizeOf(PrintDlgRec), 0);
  4057.   with PrintDlgRec do
  4058.   begin
  4059.     lStructSize := SizeOf(PrintDlgRec);
  4060.     hInstance := System.HInstance;
  4061.     F := PD_ENABLEPRINTHOOK or PD_ENABLESETUPHOOK or APrintRange[FPrintRange];
  4062.     if FCollate then Inc(F, PD_COLLATE);
  4063.     if not (poPrintToFile in FOptions) then Inc(F, PD_HIDEPRINTTOFILE);
  4064.     if not (poPageNums in FOptions) then Inc(F, PD_NOPAGENUMS);
  4065.     if not (poSelection in FOptions) then Inc(F, PD_NOSELECTION);
  4066.     if (poDisablePrintToFile in FOptions) then Inc(F, PD_DISABLEPRINTTOFILE);
  4067.     if FPrintToFile then Inc(F, PD_PRINTTOFILE);
  4068.     if poHelp in FOptions then Inc(F, PD_SHOWHELP);
  4069.     if not (poWarning in FOptions) then Inc(F, PD_NOWARNING);
  4070.     Flags := F;
  4071.     nFromPage := FFromPage;
  4072.     nToPage := FToPage;
  4073.     nMinPage := FMinPage;
  4074.     nMaxPage := FMaxPage;
  4075.     nCopies := FCopies;
  4076.     lpfnPrintHook := IvDialogHook;
  4077.     lpfnSetupHook := IvDialogHook;
  4078.     translateFunction := IvTranslatePrintDialog;
  4079.     HookCtl3D := FCtl3D;
  4080.     HookColorDlg := False;
  4081.     GetPrinter(hDevMode, hDevNames);
  4082.     CommonDialogList.Add(Self);
  4083.     hWndOwner := Application.Handle;
  4084.     if FDictionary = nil then
  4085.       translateDictionary := nil
  4086.     else
  4087.       translateDictionary := FDictionary;
  4088.     Result := TaskModalDialog(@PrintDlg, PrintDlgRec);
  4089.     CommonDialogList.Remove(Self);
  4090.     if Result then
  4091.     begin
  4092.       SetPrinter(hDevMode, hDevNames);
  4093.       F := Flags;
  4094.       FCollate := F and PD_COLLATE <> 0;
  4095.       FPrintToFile := F and PD_PRINTTOFILE <> 0;
  4096.       if F and PD_SELECTION <> 0 then FPrintRange := prSelection
  4097.       else if F and PD_PAGENUMS <> 0 then FPrintRange := prPageNums
  4098.       else FPrintRange := prAllPages;
  4099.       FFromPage := nFromPage;
  4100.       FToPage := nToPage;
  4101.       FCopies := nCopies;
  4102.     end
  4103.     else
  4104.       if ValidHandle(hDevNames) then GlobalFree(hDevNames);
  4105.   end;
  4106. end;
  4107.  
  4108. function SearchReplaceWndProc(Wnd: HWND; Msg, WParam: Word; LParam: Longint): Longint; export;
  4109.  
  4110.   function CallDefDialogProc: Longint;
  4111.   var
  4112.     DlgProc: TFarProc;
  4113.   begin
  4114.     PtrRec(DlgProc).Ofs := THandle(GetProp(Wnd, MakeIntAtom(WndProcOfsAtom)));
  4115.     PtrRec(DlgProc).Seg := THandle(GetProp(Wnd, MakeIntAtom(WndProcSegAtom)));
  4116.     Result := CallWindowProc(DlgProc, Wnd, Msg, WParam, LParam);
  4117.   end;
  4118.  
  4119. begin
  4120.   try
  4121.     case Msg of
  4122.       WM_DESTROY:
  4123.         Application.DialogHandle := 0;
  4124.  
  4125.       WM_NCACTIVATE:
  4126.         if Bool(wParam) then
  4127.           Application.DialogHandle := Wnd
  4128.         else
  4129.           Application.DialogHandle := 0;
  4130.  
  4131.       WM_NCDESTROY:
  4132.         begin
  4133.           Result := CallDefDialogProc;
  4134.           RemoveProp(Wnd, MakeIntAtom(WndProcOfsAtom));
  4135.           RemoveProp(Wnd, MakeIntAtom(WndProcSegAtom));
  4136.           Exit;
  4137.         end;
  4138.      end;
  4139.      Result := CallDefDialogProc;
  4140.    except
  4141.      Application.HandleException(nil);
  4142.    end;
  4143. end;
  4144.  
  4145. function SearchReplaceDialogHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
  4146. var
  4147.   PrevWndProc: Pointer;
  4148.   DPtr: TFindDialog;
  4149.   Rect: TRect;
  4150. begin
  4151.   Result := 0;
  4152.   try
  4153.     case Msg of
  4154.       WM_INITDIALOG:
  4155.         begin
  4156.           DPtr := TFindDialog(PFindReplace(LParam)^.lCustData);
  4157.           if (DPtr.Left <> -1) or (DPtr.Top <> -1) then
  4158.           begin
  4159.             GetWindowRect(Wnd, Rect);
  4160.             MoveWindow(Wnd, DPtr.Left, DPtr.Top, Rect.Right - Rect.Left,
  4161.               Rect.Bottom - Rect.Top, True);
  4162.           end;
  4163.           if HookCtl3D then
  4164.             Subclass3DDlg(Wnd, CTL3D_ALL);
  4165.           PrevWndProc := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  4166.           SetProp(Wnd, MakeIntAtom(WndProcOfsAtom), THandle(PtrRec(PrevWndProc).Ofs));
  4167.           SetProp(Wnd, MakeIntAtom(WndProcSegAtom), THandle(PtrRec(PrevWndProc).Seg));
  4168.           SetWindowLong(Wnd, GWL_WNDPROC, Longint(@SearchReplaceWndProc));
  4169.           translateFunction(Wnd, 0);
  4170.           Result := 1;
  4171.         end;
  4172.     else
  4173.       Result := IvDialogHook(Wnd, Msg, wParam, lParam);
  4174.     end;
  4175.   except
  4176.     Application.HandleException(nil);
  4177.   end;
  4178. end;
  4179.  
  4180. { TIvFindDialog }
  4181.  
  4182. constructor TIvFindDialog.Create(AOwner: TComponent);
  4183. begin
  4184.   inherited Create(AOwner);
  4185.   FOptions := [frDown];
  4186.   FLeft := -1;
  4187.   FTop := -1;
  4188. end;
  4189.  
  4190. destructor TIvFindDialog.Destroy;
  4191. begin
  4192.   with FFindReplace do
  4193.     if lpstrFindWhat <> nil then
  4194.     begin
  4195.       FreeMem(lpstrFindWhat, wFindWhatLen);
  4196.       lpstrFindWhat := nil;
  4197.     end;
  4198.   inherited Destroy;
  4199. end;
  4200.  
  4201. function TIvFindDialog.Message(var Msg: TMessage): Boolean;
  4202. begin
  4203.   Result := inherited Message(Msg);
  4204.   if not Result then
  4205.     if (Msg.Msg = FindMsg) and (@FFindReplace = Pointer(Msg.lParam)) then
  4206.     begin
  4207.       ConvertFieldsForCallBack;
  4208.       if (FFindReplace.Flags and FR_FINDNEXT) <> 0 then
  4209.       begin
  4210.         Find;
  4211.         Result := True;
  4212.       end
  4213.       else if (FFindReplace.Flags and FR_DIALOGTERM) <> 0 then
  4214.       begin
  4215.         FSafeHandle := 0;
  4216.         CommonDialogList.Remove(Self);
  4217.         Result := True;
  4218.       end;
  4219.     end;
  4220. end;
  4221.  
  4222. const
  4223.   FindOptions: array [TFindOption] of LongInt = (
  4224.     FR_DOWN, FR_FINDNEXT, FR_HIDEMATCHCASE, FR_HIDEWHOLEWORD,
  4225.     FR_HIDEUPDOWN, FR_MATCHCASE, FR_NOMATCHCASE, FR_NOUPDOWN, FR_NOWHOLEWORD,
  4226.     FR_REPLACE, FR_REPLACEALL, FR_WHOLEWORD, FR_SHOWHELP);
  4227.  
  4228. procedure TIvFindDialog.ConvertFields;
  4229. var
  4230.   Option: TFindOption;
  4231. begin
  4232.   with FFindReplace do
  4233.   begin
  4234.     Flags := FR_ENABLEHOOK;
  4235.     for Option := Low(Option) to High(Option) do
  4236.       if Option in FOptions then
  4237.         Flags := Flags or FindOptions[Option];
  4238.     if lpstrFindWhat = nil then
  4239.     begin
  4240.       wFindWhatLen := 255;
  4241.       GetMem(lpstrFindWhat, wFindWhatLen);
  4242.       FillChar(lpstrFindWhat^, wFindWhatLen, 0);
  4243.     end;
  4244.     StrPCopy(lpstrFindWhat, FindText);
  4245.   end;
  4246. end;
  4247.  
  4248. procedure TIvFindDialog.ConvertFieldsForCallBack;
  4249. var
  4250.   Option: TFindOption;
  4251. begin
  4252.   FFindText := StrPas(FFindReplace.lpstrFindWhat);
  4253.   FOptions := [];
  4254.   for Option := Low(Option) to High(Option) do
  4255.     if (FFindReplace.Flags and FindOptions[Option]) <> 0 then
  4256.       Include(FOptions, Option);
  4257. end;
  4258.  
  4259. function TIvFindDialog.DoExecute(Func: Pointer): Bool;
  4260. type
  4261.   TSearchFunc = function (var SearchData): HWnd;
  4262. begin
  4263.   with FFindReplace do
  4264.   begin
  4265.     if FSafeHandle <> 0 then
  4266.       SetWindowPos(FSafeHandle, HWND_TOP, 0, 0, 0, 0,
  4267.         SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW)
  4268.     else
  4269.     begin
  4270.       lStructSize := SizeOf(TFindReplace);
  4271.       hInstance := System.HInstance;
  4272.       CommonDialogList.Add(Self);
  4273.       hWndOwner := Application.Handle;
  4274.       HookCtl3D := FCtl3D;
  4275.       lCustData := LongInt(Self);
  4276.       lpfnHook := SearchReplaceDialogHook;
  4277.       if Self is TIvReplaceDialog then
  4278.         translateFunction := IvTranslateReplaceDialog
  4279.       else
  4280.         translateFunction := IvTranslateFindDialog;
  4281.       lpTemplateName := nil;
  4282.       ConvertFields;
  4283.       if FDictionary = nil then
  4284.         translateDictionary := nil
  4285.       else
  4286.         translateDictionary := FDictionary;
  4287.       FSafeHandle := TSearchFunc(Func)(FFindReplace);
  4288.     end;
  4289.   end;
  4290. end;
  4291.  
  4292. function TIvFindDialog.Execute: Boolean;
  4293. begin
  4294.   InitDictionary;
  4295.   DoExecute(@IvFindText);
  4296. end;
  4297.  
  4298. procedure TIvFindDialog.CloseDialog;
  4299. begin
  4300.   if FSafeHandle <> 0 then
  4301.     PostMessage(FSafeHandle, wm_Close, 0, 0);
  4302. end;
  4303.  
  4304. function TIvFindDialog.GetLeft: Integer;
  4305. var
  4306.   Placement: TWindowPlacement;
  4307. begin
  4308.   Result := FLeft;
  4309.   Placement.Length := SizeOf(Placement);
  4310.   if (FSafeHandle <> 0) and
  4311.      (GetWindowPlacement(FSafeHandle, @Placement) <> False) then
  4312.   begin
  4313.     Result := Placement.rcNormalPosition.Left;
  4314.     FLeft := Result;
  4315.   end;
  4316. end;
  4317.  
  4318. function TIvFindDialog.GetTop: Integer;
  4319. var
  4320.   Placement: TWindowPlacement;
  4321. begin
  4322.   Result := FTop;
  4323.   Placement.Length := SizeOf(Placement);
  4324.   if (FSafeHandle <> 0) and
  4325.      (GetWindowPlacement(FSafeHandle, @Placement) <> False) then
  4326.   begin
  4327.     Result := Placement.rcNormalPosition.Top;
  4328.     FTop := Result;
  4329.   end;
  4330. end;
  4331.  
  4332. function TIvFindDialog.GetPosition: TPoint;
  4333. var
  4334.   Placement: TWindowPlacement;
  4335. begin
  4336.   Result.X := Left;
  4337.   Result.Y := Top;
  4338.   Placement.Length := SizeOf(Placement);
  4339.   if (FSafeHandle <> 0) and
  4340.      (GetWindowPlacement(FSafehandle, @Placement) <> False) then
  4341.     Result := Placement.rcNormalPosition.TopLeft;
  4342.   FLeft := Result.X;
  4343.   FTop := Result.Y;
  4344. end;
  4345.  
  4346. procedure TIvFindDialog.SetPosition(const Point: TPoint);
  4347. var
  4348.   Rect: TRect;
  4349. begin
  4350.   if (Point.X <> FLeft) or (Point.Y <> FTop) then
  4351.   begin
  4352.     FLeft := Point.X;
  4353.     FTop := Point.Y;
  4354.     if FSafeHandle <> 0 then
  4355.     begin
  4356.       GetWindowRect(FSafeHandle, Rect);
  4357.       MoveWindow(FSafeHandle, Point.X, Point.Y, Rect.Right - Rect.Left,
  4358.         Rect.Bottom - Rect.Top, True);
  4359.     end;
  4360.   end;
  4361. end;
  4362.  
  4363. procedure TIvFindDialog.SetLeft(Value: Integer);
  4364. begin
  4365.   SetPosition(Point(Value, FTop));
  4366. end;
  4367.  
  4368. procedure TIvFindDialog.SetTop(Value: Integer);
  4369. begin
  4370.   SetPosition(Point(FLeft, Value));
  4371. end;
  4372.  
  4373. procedure TIvFindDialog.Find;
  4374. begin
  4375.   if Assigned(FOnFind) then FOnFind(Self);
  4376. end;
  4377.  
  4378. { TIvReplaceDialog }
  4379.  
  4380. destructor TIvReplaceDialog.Destroy;
  4381. begin
  4382.   with FFindReplace do
  4383.     if lpstrReplaceWith = nil then
  4384.     begin
  4385.       FreeMem(lpstrReplaceWith, wReplaceWithLen);
  4386.       lpstrReplaceWith := nil;
  4387.     end;
  4388.   inherited Destroy;
  4389. end;
  4390.  
  4391. function TIvReplaceDialog.Execute: Boolean;
  4392. begin
  4393.   InitDictionary;
  4394.   DoExecute(@CommDlg.ReplaceText);
  4395. end;
  4396.  
  4397. function TIvReplaceDialog.Message(var Msg: TMessage): Boolean;
  4398. begin
  4399.   Result := inherited Message(Msg);
  4400.   if not Result then
  4401.     if (Msg.Msg = FindMsg) and (@FFindReplace = Pointer(Msg.lParam)) then
  4402.       if (FFindReplace.Flags and (FR_REPLACE or FR_REPLACEALL)) <> 0 then
  4403.       begin
  4404.         Replace;
  4405.         Result := True;
  4406.       end;
  4407. end;
  4408.  
  4409. procedure TIvReplaceDialog.ConvertFields;
  4410. begin
  4411.   inherited ConvertFields;
  4412.   with FFindReplace do
  4413.   begin
  4414.     if lpstrReplaceWith = nil then
  4415.     begin
  4416.       wReplaceWithLen := 255;
  4417.       GetMem(lpstrReplaceWith, wReplaceWithLen);
  4418.       FillChar(lpstrReplaceWith^, wReplaceWithLen, 0);
  4419.     end;
  4420.     StrPCopy(lpstrReplaceWith, ReplaceText);
  4421.   end;
  4422. end;
  4423.  
  4424. procedure TIvReplaceDialog.ConvertFieldsForCallBack;
  4425. begin
  4426.   inherited ConvertFieldsForCallBack;
  4427.   FReplaceText := StrPas(FFindReplace.lpstrReplaceWith);
  4428. end;
  4429.  
  4430. procedure TIvReplaceDialog.Replace;
  4431. begin
  4432.   if Assigned(FOnReplace) then
  4433.     FOnReplace(Self);
  4434. end;
  4435.  
  4436. procedure DestroyGlobals; far;
  4437. begin
  4438.   if CommonDialogList <> nil then
  4439.     CommonDialogList.Free;
  4440.   GlobalDeleteAtom(WndProcOfsAtom);
  4441.   GlobalDeleteAtom(WndProcSegAtom);
  4442. end;
  4443.  
  4444. procedure InitDialogs;
  4445. var
  4446.   AtomText: array[0..17] of Char;
  4447. begin
  4448.   HelpMsg := RegisterWindowMessage(HelpMsgString);
  4449.   FindMsg := RegisterWindowMessage(FindMsgString);
  4450.   CommonDialogList := TIvCommonDialogList.Create;
  4451.   WndProcOfsAtom := GlobalAddAtom(
  4452.     StrFmt(AtomText, 'IvWndProcOfs%.4X', [HInstance]));
  4453.   WndProcSegAtom := GlobalAddAtom(
  4454.     StrFmt(AtomText, 'IvWndProcSeg%.4X', [HInstance]));
  4455.   AddExitProc(DestroyGlobals);
  4456. end;
  4457.  
  4458. begin
  4459.   InitDialogs;
  4460. {$ENDIF}
  4461. end.
  4462.  
  4463.